Klimi's new dotfiles with stow.
您最多选择25个主题 主题必须以字母或数字开头,可以包含连字符 (-),并且长度不得超过35个字符

2784 行
115 KiB

  1. ;;; ess-r-mode.el --- R customization
  2. ;; Copyright (C) 1997--2010 A.J. Rossini, Richard M. Heiberger, Martin
  3. ;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
  4. ;; Copyright (C) 2011--2017 A.J. Rossini, Richard M. Heiberger, Martin Maechler,
  5. ;; Kurt Hornik, Rodney Sparapani, Stephen Eglen and Vitalie Spinu.
  6. ;; Author: A.J. Rossini
  7. ;; Created: 12 Jun 1997
  8. ;; Maintainer: ESS-core <ESS-core@r-project.org>
  9. ;; Keywords: languages, statistics
  10. ;; This file is part of ESS.
  11. ;; This file is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15. ;; This file is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;; A copy of the GNU General Public License is available at
  20. ;; https://www.r-project.org/Licenses/
  21. ;;; Commentary:
  22. ;; This file defines all the R customizations for ESS. See ess-s-lang.el
  23. ;; for general S language customizations.
  24. ;;; Code:
  25. (eval-when-compile
  26. (require 'subr-x))
  27. (require 'cl-lib)
  28. (require 'compile)
  29. (require 'ess-mode)
  30. (require 'ess-help)
  31. (require 'ess-s-lang)
  32. (require 'ess-roxy)
  33. (require 'ess-r-completion)
  34. (require 'ess-r-syntax)
  35. (require 'ess-r-package)
  36. (require 'ess-trns)
  37. (require 'ess-r-xref)
  38. (when (>= emacs-major-version 26) (require 'ess-r-flymake)) ; Flymake rewrite in Emacs 26
  39. (declare-function ess-rdired "ess-rdired" ())
  40. (define-obsolete-variable-alias 'R-mode-hook 'ess-r-mode-hook "19.04")
  41. (defcustom ess-r-mode-hook nil
  42. "Hook run when entering `ess-r-mode'."
  43. :options '(electric-layout-local-mode)
  44. :type 'hook
  45. :group 'ess-R)
  46. (defcustom ess-r-fetch-ESSR-on-remotes nil
  47. "If non-nil, fetch ESSR from the GitHub repository.
  48. Otherwise source from local ESS installation. When 'ess-remote,
  49. fetch only with `ess-remote'. When t, always fetch from remotes.
  50. Change this variable when loading ESSR code on remotes fails
  51. systematically.
  52. Fetching happens once per new ESSR version. The archive is stored
  53. in ~/.config/ESSR/ folder. You can download and place it there
  54. manually if the remote has restricted network access."
  55. :type '(choice (const nil :tag "Never")
  56. (const 'ess-remote :tag "With ess-remote only")
  57. (const t :tag "Always"))
  58. :group 'ess-R)
  59. ;; Silence the byte compiler
  60. (defvar add-log-current-defun-header-regexp)
  61. ;; TODO: Refactor so as to not rely on dynamic scoping. After that
  62. ;; refactor, also remove the file-local-variable byte-compile-warnings
  63. ;; (not lexical) at the bottom.
  64. (defvar block)
  65. (defvar containing-sexp)
  66. (defvar indent-point)
  67. (defvar infinite)
  68. (defvar last-newline)
  69. (defvar last-pos)
  70. (defvar offset)
  71. (defvar prefix-break)
  72. (defvar prev-containing-sexp)
  73. (defvar start-pos)
  74. (defvar style)
  75. (defvar type)
  76. (define-obsolete-variable-alias 'ess-r-versions 'ess-r-runner-prefixes "ESS 19.04")
  77. (defcustom ess-r-runner-prefixes
  78. (let ((r-ver '("R-1" "R-2" "R-3" "R-devel" "R-patched")))
  79. (if (eq system-type 'darwin) (append r-ver '("R32" "R64")) r-ver))
  80. "List of partial strings for versions of R to access within ESS.
  81. Each string specifies the start of a filename. If a filename
  82. beginning with one of these strings is found on variable
  83. `exec-path', a command for that version of R is made available.
  84. For example, if the file \"R-1.8.1\" is found and this variable
  85. includes the string \"R-1\", a function called `R-1.8.1' will be
  86. available to run that version of R. If duplicate versions of the
  87. same program are found (which happens if the same path is listed
  88. on variable `exec-path' more than once), they are ignored by
  89. calling `delete-dups'. Set this variable to nil to disable
  90. searching for other versions of R. Setting this variable directly
  91. does not take effect; use either \\[customize-option] or set the
  92. value by using `ess-r-runners-reset'."
  93. :group 'ess-R
  94. :type '(repeat string)
  95. :set #'ess-r-runners-reset
  96. ;; Use `custom-initialize-default' since we call
  97. ;; `ess-r-define-runners' at the end of this file directly.
  98. :initialize #'custom-initialize-default)
  99. ;;*;; Mode definition
  100. ;;;*;;; UI (Keymaps / Menus)
  101. (defvar ess-dev-map
  102. (let (ess-dev-map)
  103. (define-prefix-command 'ess-dev-map)
  104. (define-key ess-dev-map "\C-s" #'ess-r-set-evaluation-env)
  105. (define-key ess-dev-map "s" #'ess-r-set-evaluation-env)
  106. (define-key ess-dev-map "T" #'ess-toggle-tracebug)
  107. (define-key ess-dev-map "\C-l" #'ess-r-devtools-load-package)
  108. (define-key ess-dev-map "l" #'ess-r-devtools-load-package)
  109. (define-key ess-dev-map "`" #'ess-show-traceback)
  110. (define-key ess-dev-map "~" #'ess-show-call-stack)
  111. (define-key ess-dev-map "\C-w" #'ess-watch)
  112. (define-key ess-dev-map "w" #'ess-watch)
  113. (define-key ess-dev-map "\C-d" #'ess-debug-flag-for-debugging)
  114. (define-key ess-dev-map "d" #'ess-debug-flag-for-debugging)
  115. (define-key ess-dev-map "\C-u" #'ess-debug-unflag-for-debugging)
  116. (define-key ess-dev-map "u" #'ess-debug-unflag-for-debugging)
  117. (define-key ess-dev-map "" #'ess-debug-unflag-for-debugging)
  118. (define-key ess-dev-map "\C-b" #'ess-bp-set)
  119. (define-key ess-dev-map "b" #'ess-bp-set)
  120. (define-key ess-dev-map "" #'ess-bp-set-conditional)
  121. (define-key ess-dev-map "B" #'ess-bp-set-conditional)
  122. (define-key ess-dev-map "\C-L" #'ess-bp-set-logger)
  123. (define-key ess-dev-map "L" #'ess-bp-set-logger)
  124. (define-key ess-dev-map "\C-o" #'ess-bp-toggle-state)
  125. (define-key ess-dev-map "o" #'ess-bp-toggle-state)
  126. (define-key ess-dev-map "\C-k" #'ess-bp-kill)
  127. (define-key ess-dev-map "k" #'ess-bp-kill)
  128. (define-key ess-dev-map "\C-K" #'ess-bp-kill-all)
  129. (define-key ess-dev-map "K" #'ess-bp-kill-all)
  130. (define-key ess-dev-map "\C-n" #'ess-bp-next)
  131. (define-key ess-dev-map "n" #'ess-bp-next)
  132. (define-key ess-dev-map "i" #'ess-debug-goto-input-event-marker)
  133. (define-key ess-dev-map "I" #'ess-debug-goto-input-event-marker)
  134. (define-key ess-dev-map "\C-p" #'ess-bp-previous)
  135. (define-key ess-dev-map "p" #'ess-bp-previous)
  136. (define-key ess-dev-map "\C-e" #'ess-debug-toggle-error-action)
  137. (define-key ess-dev-map "e" #'ess-debug-toggle-error-action)
  138. (define-key ess-dev-map "0" #'ess-electric-selection)
  139. (define-key ess-dev-map "1" #'ess-electric-selection)
  140. (define-key ess-dev-map "2" #'ess-electric-selection)
  141. (define-key ess-dev-map "3" #'ess-electric-selection)
  142. (define-key ess-dev-map "4" #'ess-electric-selection)
  143. (define-key ess-dev-map "5" #'ess-electric-selection)
  144. (define-key ess-dev-map "6" #'ess-electric-selection)
  145. (define-key ess-dev-map "7" #'ess-electric-selection)
  146. (define-key ess-dev-map "8" #'ess-electric-selection)
  147. (define-key ess-dev-map "9" #'ess-electric-selection)
  148. (define-key ess-dev-map "?" #'ess-tracebug-show-help)
  149. ess-dev-map)
  150. "Keymap for commands related to development and debugging.")
  151. (defvar ess-r-package-check-map
  152. (let (ess-r-package-check-map)
  153. (define-prefix-command 'ess-r-package-check-map)
  154. (define-key ess-r-package-check-map "\C-c" #'ess-r-devtools-check-package)
  155. (define-key ess-r-package-check-map "c" #'ess-r-devtools-check-package)
  156. (define-key ess-r-package-check-map "\C-w" #'ess-r-devtools-check-with-winbuilder)
  157. (define-key ess-r-package-check-map "w" #'ess-r-devtools-check-with-winbuilder)
  158. (define-key ess-r-package-check-map "h" #'ess-r-rhub-check-package)
  159. ess-r-package-check-map)
  160. "Keymap for R package checks.")
  161. (defvar ess-r-package-dev-map
  162. (let (ess-r-package-dev-map)
  163. (define-prefix-command 'ess-r-package-dev-map)
  164. (define-key ess-r-package-dev-map "\C-s" #'ess-r-set-evaluation-env)
  165. (define-key ess-r-package-dev-map "s" #'ess-r-set-evaluation-env)
  166. (define-key ess-r-package-dev-map "\C-a" #'ess-r-devtools-execute-command)
  167. (define-key ess-r-package-dev-map "a" #'ess-r-devtools-execute-command)
  168. (define-key ess-r-package-dev-map "\C-e" #'ess-r-devtools-execute-command)
  169. (define-key ess-r-package-dev-map "e" #'ess-r-devtools-execute-command)
  170. (define-key ess-r-package-dev-map "\C-b" #'ess-r-devtools-build)
  171. (define-key ess-r-package-dev-map "b" #'ess-r-devtools-build)
  172. (define-key ess-r-package-dev-map "\C-c" 'ess-r-package-check-map)
  173. (define-key ess-r-package-dev-map "c" 'ess-r-package-check-map)
  174. (define-key ess-r-package-dev-map "\C-d" #'ess-r-devtools-document-package)
  175. (define-key ess-r-package-dev-map "d" #'ess-r-devtools-document-package)
  176. (define-key ess-r-package-dev-map "g" #'ess-r-devtools-install-github)
  177. (define-key ess-r-package-dev-map "\C-i" #'ess-r-devtools-install-package)
  178. (define-key ess-r-package-dev-map "i" #'ess-r-devtools-install-package)
  179. (define-key ess-r-package-dev-map "\C-l" #'ess-r-devtools-load-package)
  180. (define-key ess-r-package-dev-map "l" #'ess-r-devtools-load-package)
  181. (define-key ess-r-package-dev-map "\C-t" #'ess-r-devtools-test-package)
  182. (define-key ess-r-package-dev-map "t" #'ess-r-devtools-test-package)
  183. (define-key ess-r-package-dev-map "\C-u" #'ess-r-devtools-unload-package)
  184. (define-key ess-r-package-dev-map "u" #'ess-r-devtools-unload-package)
  185. ess-r-package-dev-map))
  186. (easy-menu-define ess-roxygen-menu nil
  187. "Roxygen submenu."
  188. '("Roxygen"
  189. :visible (and ess-dialect (string-match "^R" ess-dialect))
  190. ["Update/Generate Template" ess-roxy-update-entry t]
  191. ["Preview Rd" ess-roxy-preview-Rd t]
  192. ["Preview HTML" ess-roxy-preview-HTML t]
  193. ["Preview text" ess-roxy-preview-text t]
  194. ["Hide all" ess-roxy-hide-all t]
  195. ["Toggle Roxygen Prefix" ess-roxy-toggle-roxy-region t]))
  196. (easy-menu-define ess-tracebug-menu nil
  197. "Tracebug submenu."
  198. '("Tracebug"
  199. :visible (and ess-dialect (string-match "^R" ess-dialect))
  200. ;; :enable ess-local-process-name
  201. ["Active?" ess-toggle-tracebug
  202. :style toggle
  203. :selected (or (and (ess-process-live-p)
  204. (ess-process-get 'tracebug))
  205. ess-use-tracebug)]
  206. ["Show traceback" ess-show-traceback (ess-process-live-p)]
  207. ["Show call stack" ess-show-call-stack (ess-process-live-p)]
  208. ["Watch" ess-watch (and (ess-process-live-p)
  209. (ess-process-get 'tracebug))]
  210. ["Error action cycle" ess-debug-toggle-error-action (and (ess-process-live-p)
  211. (ess-process-get 'tracebug))]
  212. "----"
  213. ["Flag for debugging" ess-debug-flag-for-debugging ess-local-process-name]
  214. ["Unflag for debugging" ess-debug-unflag-for-debugging ess-local-process-name]
  215. "----"
  216. ["Set BP" ess-bp-set t]
  217. ["Set conditional BP" ess-bp-set-conditional t]
  218. ["Set logger BP" ess-bp-set-logger t]
  219. ["Kill BP" ess-bp-kill t]
  220. ["Kill all BPs" ess-bp-kill-all t]
  221. ["Next BP" ess-bp-next t]
  222. ["Previous BP" ess-bp-previous t]
  223. "-----"
  224. ["About" ess-tracebug-show-help t]))
  225. (easy-menu-define ess-r-package-menu nil
  226. "Package Development submenu."
  227. '("Package development"
  228. :visible (and ess-dialect (string-match "^R" ess-dialect))
  229. ["Active?" ess-r-package-mode
  230. :style toggle
  231. :selected ess-r-package-mode]
  232. ["Select package for evaluation" ess-r-set-evaluation-env t]))
  233. (easy-menu-add-item ess-mode-menu nil ess-roxygen-menu "end-dev")
  234. (easy-menu-add-item ess-mode-menu nil ess-r-package-menu "end-dev")
  235. (easy-menu-add-item ess-mode-menu nil ess-tracebug-menu "end-dev")
  236. (easy-menu-add-item inferior-ess-mode-menu nil ess-r-package-menu "end-dev")
  237. (easy-menu-add-item inferior-ess-mode-menu nil ess-tracebug-menu "end-dev")
  238. (defvar ess-r-mode-map
  239. (let ((map (make-sparse-keymap)))
  240. (define-key map (kbd "C-c C-=") #'ess-cycle-assign)
  241. (define-key map "\M-?" #'ess-complete-object-name)
  242. (define-key map (kbd "C-c C-.") 'ess-rutils-map)
  243. map))
  244. (defvar ess-r-mode-syntax-table
  245. (let ((table (copy-syntax-table S-syntax-table)))
  246. ;; Letting Emacs treat backquoted names and %ops% as strings solves
  247. ;; many problems with regard to nested strings and quotes
  248. (modify-syntax-entry ?` "\"" table)
  249. (modify-syntax-entry ?% "\"" table)
  250. ;; Underscore is valid in R symbols
  251. (modify-syntax-entry ?_ "_" table)
  252. (modify-syntax-entry ?: "." table)
  253. (modify-syntax-entry ?@ "." table)
  254. (modify-syntax-entry ?$ "." table)
  255. table)
  256. "Syntax table for `ess-r-mode'.")
  257. (defvar ess-r-completion-syntax-table
  258. (let ((table (copy-syntax-table ess-r-mode-syntax-table)))
  259. (modify-syntax-entry ?. "_" table)
  260. (modify-syntax-entry ?: "_" table)
  261. (modify-syntax-entry ?$ "_" table)
  262. (modify-syntax-entry ?@ "_" table)
  263. table)
  264. "Syntax table used for completion and help symbol lookup.
  265. It makes underscores and dots word constituent chars.")
  266. (defvar ess-r-namespaced-load-verbose t
  267. "Whether to display information on namespaced loading.
  268. When t, loading a file into a namespaced will output information
  269. about which objects are exported and which stay hidden in the
  270. namespace.")
  271. (defun ess-r-font-lock-syntactic-face-function (state)
  272. (if (nth 3 state)
  273. ;; string case
  274. (let ((string-end (save-excursion
  275. (ess-goto-char (nth 8 state))
  276. (ess-forward-sexp)
  277. (point))))
  278. (cond
  279. ((eq (nth 3 state) ?%)
  280. (if (eq (point) (1- string-end))
  281. (when (cdr (assq 'ess-fl-keyword:operators ess-R-font-lock-keywords))
  282. 'ess-operator-face)
  283. (if (cdr (assq 'ess-R-fl-keyword:%op% ess-R-font-lock-keywords))
  284. 'ess-%op%-face
  285. 'default)))
  286. ((save-excursion
  287. (and (cdr (assq 'ess-R-fl-keyword:fun-defs ess-R-font-lock-keywords))
  288. (ess-goto-char string-end)
  289. (ess-looking-at "<-")
  290. (ess-goto-char (match-end 0))
  291. (ess-looking-at "function\\b" t)))
  292. font-lock-function-name-face)
  293. ((save-excursion
  294. (and (cdr (assq 'ess-fl-keyword:fun-calls ess-R-font-lock-keywords))
  295. (ess-goto-char string-end)
  296. (ess-looking-at "(")))
  297. ess-function-call-face)
  298. ((eq (nth 3 state) ?`)
  299. 'default)
  300. (t
  301. font-lock-string-face)))
  302. font-lock-comment-face))
  303. (defvar ess-r--non-fn-kwds
  304. '("in" "else" "break" "next" "repeat"))
  305. (defvar-local ess-r--keyword-regexp nil)
  306. (defun ess-r--find-fl-keyword (limit)
  307. "Search for R keyword and set the match data.
  308. To be used as part of `font-lock-defaults' keywords."
  309. (unless ess-r--keyword-regexp
  310. (let (fn-kwds non-fn-kwds)
  311. (dolist (kw ess-R-keywords)
  312. (if (member kw ess-r--non-fn-kwds)
  313. (push kw non-fn-kwds)
  314. (push kw fn-kwds)))
  315. (setq ess-r--keyword-regexp
  316. (concat "\\("
  317. (regexp-opt non-fn-kwds 'words)
  318. "\\)\\|\\("
  319. (regexp-opt fn-kwds 'words)
  320. "\\)"))))
  321. (let (out)
  322. (while (and (not out)
  323. (re-search-forward ess-r--keyword-regexp limit t))
  324. (save-match-data
  325. (setq out (if (match-beginning 1)
  326. ;; Non-function-like keywords: Always fontified
  327. ;; except for `in` for which we check it's part
  328. ;; of a `for` construct. Ideally we'd check that
  329. ;; other keywords like `break` or `next` are
  330. ;; part of the right syntactic construct but
  331. ;; that requires robust and efficient detection
  332. ;; of complete expressions.
  333. (if (string= (match-string 1) "in")
  334. (save-excursion
  335. (goto-char (match-beginning 1))
  336. (and (ess-backward-up-list)
  337. (forward-word -1)
  338. (looking-at "for\\s-*(")))
  339. t)
  340. ;; Function-like keywords: check if they are
  341. ;; followed by an open paren
  342. (looking-at "\\s-*(")))))
  343. out))
  344. (define-obsolete-variable-alias 'R-customize-alist 'ess-r-customize-alist "ESS 18.10.2")
  345. (defvar ess-r-customize-alist
  346. (append
  347. '((ess-local-customize-alist . 'ess-r-customize-alist)
  348. (ess-dialect . "R")
  349. (ess-suffix . "R")
  350. (ess-traceback-command . ess-r-traceback-command)
  351. (ess-call-stack-command . ess-r-call-stack-command)
  352. (ess-mode-completion-syntax-table . ess-r-completion-syntax-table)
  353. (ess-build-eval-message-function . #'ess-r-build-eval-message)
  354. (ess-dump-filename-template . ess-r-dump-filename-template)
  355. (ess-change-sp-regexp . ess-r-change-sp-regexp)
  356. (ess-help-sec-regex . ess-help-r-sec-regex)
  357. (ess-help-sec-keys-alist . ess-help-r-sec-keys-alist)
  358. (ess-function-pattern . ess-r-function-pattern)
  359. (ess-object-name-db-file . "ess-r-namedb.el")
  360. (ess-smart-operators . ess-r-smart-operators)
  361. (inferior-ess-program . inferior-ess-r-program)
  362. (inferior-ess-objects-command . inferior-ess-r-objects-command)
  363. (inferior-ess-search-list-command . "search()\n")
  364. (inferior-ess-help-command . inferior-ess-r-help-command)
  365. (inferior-ess-exit-command . "q()")
  366. (ess-error-regexp-alist . ess-r-error-regexp-alist)
  367. (ess-describe-object-at-point-commands . 'ess-r-describe-object-at-point-commands)
  368. (ess-STERM . "iESS")
  369. (ess-editor . ess-r-editor)
  370. (ess-pager . ess-r-pager))
  371. S-common-cust-alist)
  372. "Variables to customize for R.")
  373. (cl-defmethod ess-build-tags-command (&context (ess-dialect "R"))
  374. "Return tags command for R."
  375. "rtags('%s', recursive = TRUE, pattern = '\\\\.[RrSs](rw)?$',ofile = '%s')")
  376. (defvar ess-r-traceback-command
  377. "local({cat(geterrmessage(), \
  378. '---------------------------------- \n', \
  379. fill=TRUE); try(traceback(), silent=TRUE)})\n")
  380. (defvar ess-r-call-stack-command "traceback(1)\n")
  381. (defvar ess-r-dump-filename-template
  382. (replace-regexp-in-string
  383. "S$" "R" ess-dump-filename-template-proto))
  384. (defvar ess-r-ac-sources
  385. '(ac-source-R))
  386. (defvar ess-r-company-backends
  387. '((company-R-library company-R-args company-R-objects :separate)))
  388. (defconst ess-help-r-sec-regex "^[A-Z][A-Za-z].+:$"
  389. "Reg(ular) Ex(pression) of section headers in help file.")
  390. (defconst ess-help-r-sec-keys-alist
  391. '((?a . "\\s *Arguments:")
  392. (?d . "\\s *Description:")
  393. (?D . "\\s *Details:")
  394. (?t . "\\s *Details:")
  395. (?e . "\\s *Examples:")
  396. (?n . "\\s *Note:")
  397. (?r . "\\s *References:")
  398. (?s . "\\s *See Also:")
  399. (?u . "\\s *Usage:")
  400. (?v . "\\s *Value[s]?") ;
  401. )
  402. "Alist of (key . string) pairs for use in help section searching.")
  403. (defvar ess-r-error-regexp-alist '(R R1 R2 R3 R4 R-recover)
  404. "List of symbols which are looked up in `compilation-error-regexp-alist-alist'.")
  405. (dolist (l '(;; Takes precedence over R1 below in English locales, and allows spaces in file path
  406. (R "\\(\\(?: at \\|(@\\)\\([^#()\n]+\\)[#:]\\([0-9]+\\)\\)" 2 3 nil 2 1)
  407. ;; valgrind style (stl_numeric.h:183)
  408. (R1 "(\\([^ ):\n]+\\):\\([0-9]+\\)?)" 1 2 nil 2)
  409. (R2 "(\\(\\w+ \\([^())\n]+\\)#\\([0-9]+\\)\\))" 2 3 nil 2 1)
  410. ;; Precedes R4 and allows spaces in file path, Starts at bol or with ": " (patterns 3,4,5,6,9)
  411. (R3 "\\(?:^ *\\|: ?\\)\\([^-+[:digit:] \t\n]:?[^: \t\n]*\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):\\)?" 1 2 3 2 1)
  412. ;; Don't start with digit; no spaces
  413. (R4 "\\([^-+ [:digit:]][^: \t\n]+\\):\\([0-9]+\\):\\([0-9]+\\):" 1 2 3 2 1)
  414. (R-recover " *[0-9]+: +\\([^:\n\t]+?\\)#\\([0-9]+:\\)" 1 2 nil 2 1)))
  415. (cl-pushnew l compilation-error-regexp-alist-alist))
  416. (define-obsolete-variable-alias 'ess-r-versions-created 'ess-r-created-runners "ESS 18.10")
  417. (defvar ess-r-created-runners nil
  418. "List of R-versions found from `ess-r-runner-prefixes' on the system.")
  419. ;;;*;;; Mode init
  420. (define-obsolete-variable-alias 'ess-R-post-run-hook 'ess-r-post-run-hook "ESS 18.10.2")
  421. (defvar ess-r-post-run-hook nil
  422. "Functions run in process buffer after the initialization of R process.")
  423. ;;;###autoload
  424. (defun run-ess-r (&optional start-args)
  425. "Call 'R', the 'GNU S' system from the R Foundation.
  426. Optional prefix (\\[universal-argument]) allows to set command line arguments, such as
  427. --vsize. This should be OS agnostic.
  428. If you have certain command line arguments that should always be passed
  429. to R, put them in the variable `inferior-R-args'.
  430. START-ARGS can be a string representing an argument, a list of
  431. such strings, or any other non-nil value. In the latter case, you
  432. will be prompted to enter arguments interactively."
  433. (interactive "P")
  434. (ess-write-to-dribble-buffer ;; for debugging only
  435. (format
  436. "\n(R): ess-dialect=%s, buf=%s, start-arg=%s\n current-prefix-arg=%s\n"
  437. ess-dialect (current-buffer) start-args current-prefix-arg))
  438. (unless (or (file-remote-p default-directory)
  439. (and ess-startup-directory
  440. (file-remote-p ess-startup-directory))
  441. ;; TODO: Once we drop Emacs 26 support, can probably
  442. ;; just use the REMOTE argument of `executable-find'.
  443. (executable-find inferior-ess-r-program))
  444. (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)
  445. (user-error "%s program not found" inferior-ess-r-program))
  446. (let* ((r-always-arg
  447. (if (or ess-microsoft-p (eq system-type 'cygwin))
  448. "--ess "
  449. ;; else: "Unix alike"
  450. (if (not ess-R-readline) "--no-readline ")))
  451. (start-args
  452. (cond ((stringp start-args)
  453. start-args)
  454. ((and start-args
  455. (listp start-args)
  456. (cl-every 'stringp start-args))
  457. (mapconcat 'identity start-args " "))
  458. (start-args
  459. (read-string
  460. (concat "Starting Args"
  461. (if r-always-arg
  462. (concat " [other than '" r-always-arg "']"))
  463. " ? ")))))
  464. (r-start-args
  465. (concat r-always-arg
  466. inferior-R-args " " ; add space just in case
  467. start-args))
  468. (debug (string-match-p " -d \\| --debugger=" r-start-args))
  469. use-dialog-box)
  470. (when (or ess-microsoft-p
  471. (eq system-type 'cygwin))
  472. (setq use-dialog-box nil)
  473. (when ess-microsoft-p ;; default-process-coding-system would break UTF locales on Unix
  474. (setq default-process-coding-system '(undecided-dos . undecided-dos))))
  475. (let ((inf-buf (inferior-ess r-start-args ess-r-customize-alist debug)))
  476. (with-current-buffer inf-buf
  477. (ess-process-put 'funargs-pre-cache ess-r--funargs-pre-cache)
  478. (if debug
  479. (progn
  480. ;; We need to use callback, because R might start with a gdb process
  481. (ess-process-put 'callbacks '(inferior-ess-r--init-callback))
  482. ;; Trigger the callback
  483. (process-send-string (get-buffer-process inf-buf) "r\n"))
  484. (ess-wait-for-process)
  485. (R-initialize-on-start)
  486. (comint-goto-process-mark))
  487. (ess-write-to-dribble-buffer
  488. (format "(R): inferior-ess-language-start=%s\n"
  489. inferior-ess-language-start)))
  490. ;; FIXME: Current ob-R expects current buffer set to process buffer
  491. (set-buffer inf-buf))))
  492. ;;;###autoload
  493. (defalias 'R #'run-ess-r)
  494. (defun inferior-ess-r--adjust-startup-directory (dir dialect)
  495. "Adjust startup directory DIR if DIALECT is R.
  496. If in a package project, prefer the tests directory but only if
  497. the package directory was selected in the first place."
  498. (if (string= dialect "R")
  499. (let* ((project-dir (cdr (ess-r-package-project)))
  500. (tests-dir (expand-file-name (file-name-as-directory "tests")
  501. project-dir)))
  502. (if (and project-dir
  503. (string= project-dir dir)
  504. (string= default-directory tests-dir))
  505. tests-dir
  506. dir))
  507. dir))
  508. (defun inferior-ess-r--init-callback (_proc _name)
  509. (R-initialize-on-start))
  510. (defun R-initialize-on-start ()
  511. "This function is run after the first R prompt.
  512. Executed in process buffer."
  513. (ess-command (format
  514. "if(identical(getOption('pager'),
  515. file.path(R.home(), 'bin', 'pager')))
  516. options(pager='%s')\n"
  517. inferior-ess-pager))
  518. (ess-r-load-ESSR)
  519. (when inferior-ess-language-start
  520. (ess-command (concat inferior-ess-language-start "\n")))
  521. ;; tracebug
  522. (when ess-use-tracebug (ess-tracebug 1))
  523. (add-hook 'ess-presend-filter-functions 'ess-R-scan-for-library-call nil 'local)
  524. (run-hooks 'ess-r-post-run-hook))
  525. (defun ess-r--skip-function ()
  526. ;; Assumes the point is at function start
  527. (if (looking-at-p ess-r-set-function-start)
  528. (forward-list 1) ; get over the entire setXyz(...)
  529. (forward-list 1) ; get over arguments
  530. (if (looking-at-p "[ \t\n]*{")
  531. (forward-sexp 1) ;; move over {...}
  532. ;; {..}-less case
  533. (skip-chars-forward " \t\n")
  534. (goto-char (cadr (ess-continuations-bounds))))))
  535. ;; `beginning-of-defun' protocol:
  536. ;; 1) assumes that defuns are at the top level (e.g. always moves to bol)
  537. (defun ess-r-beginning-of-defun (&optional arg)
  538. "Move to beginning a top level function.
  539. ARG is as in `beginning-of-defun'."
  540. (ess-r-beginning-of-function arg t))
  541. ;; `end-of-defun' protocol:
  542. ;; 1) Uses beginning-of-defun-function with negative arg
  543. ;; 2) Assumes that beginning-of-defun-function with -1 arg finds current defun
  544. ;; when point is just in front of the function
  545. (defun ess-r-end-of-defun (&optional arg)
  546. "End of top level function.
  547. ARG is as in `end-of-defun'."
  548. (ess-r-end-of-function arg t))
  549. (defun ess-r-beginning-of-function (&optional arg top-level)
  550. "Leave (and return) the point at the beginning of the current ESS function.
  551. When ARG is positive, search for beginning of function backward,
  552. otherwise forward. Value of ARG is currently ignored. Return the
  553. new position, or nil if no-match. If TOP-LEVEL is non-nil, search
  554. for top-level functions only."
  555. (setq arg (or arg 1))
  556. (let ((start-point (point))
  557. done)
  558. ;; In case we are at the start of a function, skip past new lines.
  559. (when (> arg 0)
  560. ;; Start search from a forward position in order to capture current
  561. ;; function start. But not when arg < 0; see end-of-defun protocol above.
  562. (forward-line 2))
  563. (while (and (not done)
  564. (re-search-backward ess-r-function-pattern nil t arg))
  565. (unless (ess-inside-string-or-comment-p)
  566. (setq done
  567. (if top-level
  568. (= (car (syntax-ppss (match-beginning 0))) 0)
  569. t))
  570. (if (< arg 0)
  571. ;; move to match-end to avoid the infloop in re-search-backward
  572. (goto-char (if done (match-beginning 0) (match-end 0)))
  573. ;; Backward regexp match stops at the minimal match (e.g. partial
  574. ;; function name), so we need a bit more work here.
  575. (beginning-of-line)
  576. (re-search-forward ess-r-function-pattern)
  577. (goto-char (match-beginning 0))
  578. (when (<= start-point (point))
  579. (setq done nil)))))
  580. (if done
  581. (point)
  582. (goto-char start-point)
  583. nil)))
  584. (defun ess-r-end-of-function (&optional arg top-level)
  585. "Leave the point at the end of the current function.
  586. When ARG is positive, search for end of function forward,
  587. otherwise backward. Move to point and return point if search was
  588. successful, otherwise nil. If TOP-LEVEL is non-nil, search for
  589. top level functions only."
  590. (setq arg (or arg 1))
  591. (let* ((start-pos (point))
  592. (search-fn (lambda (lim)
  593. (let ((foundp nil))
  594. (while (and (not foundp)
  595. (re-search-forward ess-r-function-pattern nil t))
  596. (when (< arg 0)
  597. ;; re-search-backward is a forward search
  598. ;; internally, so we need to bol in order to avoid
  599. ;; the infloop
  600. (beginning-of-line))
  601. (setq foundp
  602. (unless (ess-inside-string-or-comment-p)
  603. (if top-level
  604. (= 0 (car (save-excursion (syntax-ppss (match-beginning 0)))))
  605. (>= (point) lim)))))
  606. (if foundp
  607. (progn (goto-char (match-beginning 0))
  608. (ess-r--skip-function))
  609. (goto-char start-pos))))))
  610. (ess-r-beginning-of-function 1 top-level)
  611. (if (< (point) start-pos)
  612. ;; Moved back. We were either inside a function or after a function.
  613. (progn
  614. (ess-r--skip-function)
  615. ;; For negative ARG we are done.
  616. (when (and (> arg 0)
  617. (<= (point) start-pos))
  618. (funcall search-fn start-pos)))
  619. ;; No function before point; search forward on positive ARG.
  620. (when (> arg 0)
  621. (funcall search-fn start-pos)))))
  622. ;;;###autoload
  623. (define-derived-mode ess-r-mode ess-mode "ESS[R]"
  624. "Major mode for editing R source. See `ess-mode' for more help."
  625. :group 'ess-R
  626. (ess-setq-vars-local ess-r-customize-alist)
  627. (setq-local ess-font-lock-keywords 'ess-R-font-lock-keywords)
  628. (setq-local paragraph-start (concat "\\s-*$\\|" page-delimiter))
  629. (setq-local paragraph-separate (concat "\\s-*$\\|" page-delimiter))
  630. (setq-local paragraph-ignore-fill-prefix t)
  631. (setq-local indent-line-function #'ess-r-indent-line)
  632. (setq-local comment-indent-function #'ess-calculate-indent)
  633. (setq-local add-log-current-defun-header-regexp "^\\(.+\\)\\s-+<-[ \t\n]*function")
  634. (setq-local font-lock-syntactic-face-function #'ess-r-font-lock-syntactic-face-function)
  635. (setq-local electric-layout-rules '((?{ . after)))
  636. ;; indentation
  637. (add-hook 'hack-local-variables-hook #'ess-set-style nil t)
  638. ;; eldoc
  639. (add-function :before-until (local 'eldoc-documentation-function)
  640. #'ess-r-eldoc-function)
  641. (when ess-use-eldoc (eldoc-mode))
  642. ;; auto-complete
  643. (ess--setup-auto-complete ess-r-ac-sources)
  644. ;; company
  645. (ess--setup-company ess-r-company-backends)
  646. (setq-local prettify-symbols-alist ess-r-prettify-symbols)
  647. (setq font-lock-defaults '(ess-build-font-lock-keywords nil nil ((?\. . "w") (?\_ . "w"))))
  648. (remove-hook 'completion-at-point-functions 'ess-filename-completion 'local) ;; should be first
  649. (add-hook 'completion-at-point-functions 'ess-r-object-completion nil 'local)
  650. (add-hook 'completion-at-point-functions #'ess-r-package-completion nil 'local)
  651. (add-hook 'completion-at-point-functions 'ess-filename-completion nil 'local)
  652. (add-hook 'xref-backend-functions #'ess-r-xref-backend nil 'local)
  653. (if (fboundp 'ess-add-toolbar) (ess-add-toolbar))
  654. ;; imenu is needed for `which-function'
  655. (setq imenu-generic-expression ess-imenu-S-generic-expression)
  656. (when ess-imenu-use-S
  657. (imenu-add-to-menubar "Imenu-R"))
  658. (setq-local beginning-of-defun-function #'ess-r-beginning-of-defun)
  659. (setq-local end-of-defun-function #'ess-r-end-of-defun)
  660. (ess-roxy-mode))
  661. ;;;###autoload
  662. (defalias 'R-mode 'ess-r-mode)
  663. ;;;###autoload
  664. (defalias 'r-mode 'ess-r-mode)
  665. ;;;###autoload
  666. (add-to-list 'auto-mode-alist '("/R/.*\\.q\\'" . ess-r-mode))
  667. ;;;###autoload
  668. (add-to-list 'auto-mode-alist '("\\.[rR]\\'" . ess-r-mode))
  669. ;;;###autoload
  670. (add-to-list 'auto-mode-alist '("\\.[rR]profile\\'" . ess-r-mode))
  671. ;;;###autoload
  672. (add-to-list 'auto-mode-alist '("NAMESPACE\\'" . ess-r-mode))
  673. ;;;###autoload
  674. (add-to-list 'auto-mode-alist '("CITATION\\'" . ess-r-mode))
  675. ;;*;; Miscellaneous
  676. (defun ess-R-arch-2-bit (arch)
  677. "Translate R's architecture shortcuts/directory names to 'bits'.
  678. ARCH \"32\" or \"64\" (for now)."
  679. (if (string= arch "i386") "32"
  680. ;; else:
  681. "64"))
  682. (defun ess-rterm-arch-version (long-path &optional give-cons)
  683. "Find a name for LONG-PATH, an absolute path to R on Windows.
  684. Returns either Name, a string, or a (Name . Path) cons, such as
  685. (\"R-2.12.1-64bit\" . \"C:/Program Files/R/R-2.12.1/bin/x64/Rterm.exe\")
  686. \"R-x.y.z/bin/Rterm.exe\" will return \"R-x.y.z\", for R-2.11.x and older.
  687. \"R-x.y.z/bin/i386/Rterm.exe\" will return \"R-x.y.z-32bit\", for R-2.12.x and newer.
  688. \"R-x.y.z/bin/x64/Rterm.exe\" will return \"R-x.y.z-64bit\", for R-2.12.x and newer."
  689. (let* ((dir (directory-file-name (file-name-directory long-path)))
  690. (dir2 (directory-file-name (file-name-directory dir)))
  691. (v-1up (file-name-nondirectory dir));; one level up
  692. (v-2up (file-name-nondirectory dir2));; two levels up; don't want "bin" ...
  693. (v-3up (file-name-nondirectory ;; three levels up; no "bin" for i386, x64 ...
  694. (directory-file-name (file-name-directory dir2))))
  695. (val (if (string= v-2up "bin")
  696. (concat v-3up "-" (ess-R-arch-2-bit v-1up) "bit")
  697. ;; pre R-2.12.x, or when there's no extra arch-specific sub directory:
  698. v-2up)))
  699. (if give-cons
  700. (cons val long-path)
  701. val)))
  702. (defun ess-r-define-runners (&optional verbose)
  703. "Generate functions for starting other versions of R.
  704. See `ess-r-runner-prefixes' for strings that determine which functions
  705. are created. On MS Windows, this works using
  706. `ess-rterm-version-paths' instead.
  707. The functions will normally be placed on the menubar and stored
  708. as `ess-r-created-runners' upon ESS initialization."
  709. (when ess-r-runner-prefixes
  710. (let ((versions
  711. ;; Find which versions of R we want. Remove the pathname, leaving just
  712. ;; the name of the executable.
  713. (if ess-microsoft-p
  714. (mapcar (lambda (v) (car (ess-rterm-arch-version v 'give-cons)))
  715. ess-rterm-version-paths)
  716. (delete-dups
  717. (mapcar #'file-name-nondirectory
  718. (apply #'nconc
  719. (mapcar #'ess-find-exec-completions
  720. ess-r-runner-prefixes)))))))
  721. ;; Iterate over each string in VERSIONS, creating a new defun each time.
  722. (setq ess-r-created-runners versions)
  723. (if verbose
  724. (message "Recreated %d R versions known to ESS: %s"
  725. (length versions) versions))
  726. (if ess-microsoft-p
  727. (cl-mapcar (lambda (v p) (ess-define-runner v "R" p)) versions ess-rterm-version-paths)
  728. (mapc (lambda (v) (ess-define-runner v "R")) versions))
  729. ;; Add to menu
  730. (when ess-r-created-runners
  731. ;; new-menu will be a list of 3-vectors, of the form:
  732. ;; ["R-1.8.1" R-1.8.1 t]
  733. (let ((new-menu (mapcar (lambda(x) (vector x (intern x) t))
  734. ess-r-created-runners)))
  735. (easy-menu-add-item ess-mode-menu '("Start Process")
  736. (cons "Other" new-menu))
  737. (easy-menu-add-item inferior-ess-mode-menu '("Process")
  738. (cons "R processes" new-menu)))))))
  739. (defun ess-r-redefine-runners (&optional verbose)
  740. "Regenerate runners, i.e. `M-x R-*` possibilities.
  741. Call `fmakunbound' on all elements of `ess-r-created-runners', then define new runners."
  742. (interactive "P")
  743. (dolist (f ess-r-created-runners)
  744. (fmakunbound (intern f)))
  745. (setq ess-r-created-runners nil)
  746. (ess-r-define-runners verbose))
  747. (defun ess-r-runners-reset (sym val)
  748. "Regenerate runners.
  749. Set SYM to VAL and call `ess-r-redefine-runners'."
  750. (set-default sym val)
  751. (ess-r-redefine-runners))
  752. (define-obsolete-function-alias
  753. 'ess-r-versions-create 'ess-r-define-runners "ESS 18.10")
  754. (defvar ess-newest-R nil
  755. "Stores the newest version of R that has been found.
  756. Used as a cache, within `ess-find-newest-R'. Do not use this value
  757. directly, but instead call the function \\[ess-find-newest-R].")
  758. (defcustom ess-prefer-higher-bit t
  759. "Non-nil means prefer higher bit architectures of R.
  760. e.g. prefer 64 bit over 32 bit. This is currently used only
  761. by the code on Windows for finding the newest version of R."
  762. :group 'ess-R
  763. :type 'boolean)
  764. (defun ess-rterm-prefer-higher-bit ()
  765. "Optionally remove 32bit Rterms from being candidate for `run-ess-r-newest'.
  766. Return the list of candidates for being `run-ess-r-newest'. Filtering is
  767. done iff `ess-prefer-higher-bit' is non-nil. This is used only by
  768. Windows when running `ess-find-newest-R'."
  769. (if ess-prefer-higher-bit
  770. ;; filter out 32 bit elements
  771. (let ((filtered
  772. (delq nil
  773. (mapcar (lambda (x) (unless (string-match "/i386/Rterm.exe" x) x))
  774. ess-rterm-version-paths))))
  775. (if (null filtered)
  776. ;; if none survived filtering, keep the original list
  777. ess-rterm-version-paths
  778. filtered))
  779. ess-rterm-version-paths))
  780. (defun run-ess-r-newest (&optional start-args)
  781. "Find the newest version of R available, and run it.
  782. Subsequent calls to `run-ess-r-newest' will run that version,
  783. rather than searching again for the newest version. Providing
  784. START-ARGS (interactively, with \\[universal-argument]) will
  785. prompt for command line arguments."
  786. (interactive "P")
  787. (unless ess-newest-R
  788. (message "Finding all versions of R on your system...")
  789. (setq ess-newest-R
  790. (ess-find-newest-date
  791. (mapcar #'ess-r-version-date
  792. (if ess-microsoft-p
  793. (ess-rterm-prefer-higher-bit)
  794. (add-to-list 'ess-r-created-runners inferior-ess-r-program))))))
  795. (let ((inferior-ess-r-program ess-newest-R))
  796. (run-ess-r start-args)))
  797. (defalias 'R-newest 'run-ess-r-newest)
  798. ;; (ess-r-version-date "R-2.5.1") (ess-r-version-date "R-patched")
  799. ;; (ess-r-version-date "R-1.2.1") (ess-r-version-date "R-1.8.1")
  800. ;; Windows:
  801. ;; (ess-r-version-date "C:/Program Files (x86)/R/R-2.11.1/bin/Rterm.exe")
  802. ;; Note that for R-devel, ver-string is something like
  803. ;; R version 2.6.0 Under development (unstable) (2007-07-14 r42234)
  804. ;; Antique examples are 'R 1.0.1 (April 14, 2000)' or 'R 1.5.1 (2002-06-17).'
  805. (defun ess-r-version-date (rver)
  806. "Return the date of the version of R named RVER.
  807. The date is returned as a date string. If the version of R could
  808. not be found from the output of the RVER program, \"-1\" is
  809. returned."
  810. (let ((date "-1")
  811. (ver-string (shell-command-to-string
  812. ;; here, MS Windows (shell-command) needs a short name:
  813. (concat (if (and ess-microsoft-p
  814. ;; silence byte compiler warns about w32-fns
  815. (fboundp 'w32-short-file-name))
  816. (w32-short-file-name rver)
  817. rver)
  818. " --version"))))
  819. (when (string-match
  820. "R \\(version \\)?[1-9][^\n]+ (\\(2[0-9-]+\\)\\( r[0-9]+\\)?)"
  821. ver-string)
  822. (setq date (match-string 2 ver-string)))
  823. (cons date rver)))
  824. (defun ess-current-R-version ()
  825. "Get the version of R currently running in the ESS buffer as a string."
  826. (ess-make-buffer-current)
  827. (car (ess-get-words-from-vector "as.character(.ess.Rversion)\n")))
  828. (defun ess-current-R-at-least (version)
  829. "Is the version of R (in the ESS buffer) at least (\">=\") VERSION ?
  830. Examples: (ess-current-R-at-least '2.7.0)
  831. or (ess-current-R-at-least \"2.5.1\")"
  832. (ess-make-buffer-current)
  833. (string= "TRUE"
  834. (car (ess-get-words-from-vector
  835. (format "as.character(.ess.Rversion >= \"%s\")\n" version)))))
  836. (defun ess-find-newest-date (rvers)
  837. "Find the newest version of R given in the a-list RVERS.
  838. Each element of RVERS is a dotted pair (date . R-version), where
  839. date is given as e.g.\"2007-11-30\" so that we can compare dates
  840. as strings. If a date is listed as \"-1\", that version of R
  841. could not be found.
  842. If the value returned is nil, no valid newest version of R could be found."
  843. (let (new-r this-r
  844. (new-time "0"))
  845. (while rvers
  846. (setq this-r (car rvers)
  847. rvers (cdr rvers))
  848. (when (string< new-time (car this-r))
  849. (setq new-time (car this-r)
  850. new-r (cdr this-r))))
  851. new-r))
  852. (defun ess-find-rterm (&optional ess-R-root-dir bin-Rterm-exe)
  853. "Find the full path of all occurrences of Rterm.exe under the ESS-R-ROOT-DIR.
  854. If ESS-R-ROOT-DIR is nil, construct it by looking for an
  855. occurrence of Rterm.exe in the `exec-path'. If there are no
  856. occurrences of Rterm.exe in the `exec-path', then use
  857. `ess-program-files' (which evaluates to something like
  858. \"c:/progra~1/R/\" in English locales) which is the default
  859. location for the R distribution. If BIN-RTERM-EXE is nil, then
  860. use \"bin/Rterm.exe\"."
  861. (if (not ess-R-root-dir)
  862. (let ((Rpath (executable-find "Rterm")))
  863. (setq ess-R-root-dir
  864. (expand-file-name
  865. (if Rpath
  866. (concat (file-name-directory Rpath) "../../")
  867. (concat ess-program-files "/R/"))))
  868. (ess-write-to-dribble-buffer
  869. (format "(ess-find-rterm): ess-R-root-dir = '%s'\n" ess-R-root-dir))))
  870. (if (not bin-Rterm-exe) (setq bin-Rterm-exe "bin/Rterm.exe"))
  871. (when (file-directory-p ess-R-root-dir) ; otherwise file-name-all-.. errors
  872. (setq ess-R-root-dir
  873. (replace-regexp-in-string "[\\]" "/" ess-R-root-dir))
  874. (let ((R-ver
  875. (ess-drop-non-directories
  876. (ess-flatten-list
  877. (mapcar (lambda (r-prefix)
  878. (file-name-all-completions r-prefix ess-R-root-dir))
  879. (append '("rw") ess-r-runner-prefixes))))))
  880. (mapcar (lambda (dir)
  881. (let ((R-path
  882. (concat ess-R-root-dir
  883. (replace-regexp-in-string "[\\]" "/" dir)
  884. bin-Rterm-exe)))
  885. (if (file-exists-p R-path) R-path)))
  886. R-ver))))
  887. (cl-defmethod ess-font-lock-keywords (&context (major-mode ess-r-transcript-mode))
  888. 'ess-R-font-lock-keywords)
  889. ;;;###autoload
  890. (define-derived-mode ess-r-transcript-mode ess-transcript-mode "ESS R Transcript"
  891. "A Major mode for R transcript files."
  892. :syntax-table ess-r-mode-syntax-table
  893. :group 'ess
  894. (ess-setq-vars-local ess-r-customize-alist)
  895. (setq-local comint-prompt-regexp inferior-S-prompt)
  896. (setq-local ess-font-lock-keywords 'ess-R-font-lock-keywords)
  897. (setq-local paragraph-start (concat "\\s-*$\\|" page-delimiter))
  898. (setq-local paragraph-separate (concat "\\s-*$\\|" page-delimiter))
  899. (setq-local paragraph-ignore-fill-prefix t)
  900. (setq-local indent-line-function #'ess-r-indent-line)
  901. (setq-local add-log-current-defun-header-regexp "^\\(.+\\)\\s-+<-[ \t\n]*function")
  902. (setq-local font-lock-syntactic-face-function #'ess-r-font-lock-syntactic-face-function)
  903. (setq-local prettify-symbols-alist ess-r-prettify-symbols)
  904. (setq font-lock-defaults '(ess-build-font-lock-keywords
  905. nil nil ((?\. . "w") (?\_ . "w") (?' . ".")))))
  906. (fset 'r-transcript-mode 'ess-r-transcript-mode)
  907. ;;;###autoload
  908. (add-to-list 'auto-mode-alist '("\\.[Rr]out" . ess-r-transcript-mode))
  909. ;;;###autoload
  910. (add-to-list 'interpreter-mode-alist '("Rscript" . ess-r-mode))
  911. ;;;###autoload
  912. (add-to-list 'interpreter-mode-alist '("r" . ess-r-mode))
  913. (defun ess-r-fix-T-F (&optional from quietly)
  914. "Change T/F into TRUE and FALSE cautiously.
  915. Do not change in comments and strings. Start at FROM, which
  916. defaults to point, and change to end of buffer. When QUIETLY, do
  917. not issue messages."
  918. (interactive "d\nP"); point and prefix (C-u)
  919. (save-excursion
  920. (goto-char from)
  921. (ess-rep-regexp "\\(\\([][=,()]\\|<-\\) *\\)T\\>" "\\1TRUE"
  922. 'fixcase nil (not quietly))
  923. (goto-char from)
  924. (ess-rep-regexp "\\(\\([][=,()]\\|<-\\) *\\)F\\>" "\\1FALSE"
  925. 'fixcase nil (not quietly))))
  926. (define-obsolete-function-alias 'R-fix-T-F 'ess-r-fix-T-F
  927. "ESS 18.10")
  928. (defvar ess--packages-cache nil
  929. "Cache var to store package names.
  930. Used by `ess-r-install-library'.")
  931. (defvar ess--CRAN-mirror nil
  932. "CRAN mirror name cache.")
  933. (cl-defmethod ess-install-library--override (update package &context (ess-dialect "R"))
  934. "Prompt and install R PACKAGE.
  935. With argument UPDATE, update cached packages list."
  936. (inferior-ess-r-force)
  937. (when (equal "@CRAN@" (car (ess-get-words-from-vector "getOption('repos')[['CRAN']]\n")))
  938. (ess-set-CRAN-mirror ess--CRAN-mirror)
  939. (ess-wait-for-process (get-process ess-current-process-name))
  940. (unless package (setq update t)))
  941. (when (or update
  942. (not ess--packages-cache))
  943. (message "Fetching R packages ... ")
  944. (setq ess--packages-cache
  945. (ess-get-words-from-vector "print(rownames(available.packages()), max=1e6)\n")))
  946. (let* ((ess-eval-visibly-p t)
  947. (package (or package
  948. (ess-completing-read "Package to install" ess--packages-cache))))
  949. (process-send-string (get-process ess-current-process-name)
  950. (format "install.packages('%s')\n" package))
  951. (display-buffer (buffer-name (ess-get-process-buffer)))))
  952. (defun ess-setRepositories ()
  953. "Call setRepositories()."
  954. (interactive)
  955. (if (not (string-match "^R" ess-dialect))
  956. (message "Sorry, not available for %s" ess-dialect)
  957. (ess-eval-linewise "setRepositories(FALSE)\n")))
  958. (defun ess-set-CRAN-mirror (&optional mirror)
  959. "Set cran MIRROR."
  960. (interactive)
  961. (let ((mirror-cmd "local({r <- getOption('repos'); r['CRAN'] <- '%s';options(repos=r)})\n"))
  962. (if mirror
  963. (ess-command (format mirror-cmd mirror))
  964. (when-let ((M1 (ess-get-words-from-vector "local({out <- getCRANmirrors(local.only=TRUE); print(paste(out$Name,'[',out$URL,']', sep=''))})\n"))
  965. (mirror (ess-completing-read "Choose CRAN mirror" M1 nil t))
  966. (url (car (cl-member mirror M1 :test #'string=))))
  967. (setq ess--CRAN-mirror (progn (string-match "\\(.*\\)\\[\\(.*\\)\\]$" url)
  968. (match-string 2 url)))
  969. (ess-command (format mirror-cmd ess--CRAN-mirror)))))
  970. (message "CRAN mirror: %s" (car (ess-get-words-from-vector "getOption('repos')[['CRAN']]\n"))))
  971. (define-obsolete-function-alias 'ess-setCRANMiror 'ess-set-CRAN-mirror "ESS 18.10")
  972. (defun ess-r-check-install-package (pkg)
  973. "Check if package PKG is installed and offer to install if not."
  974. (unless (ess-boolean-command (format "print(requireNamespace('%s', quietly = TRUE))\n" pkg))
  975. (if (y-or-n-p (format "Package '%s' is not installed. Install? " pkg))
  976. (ess-eval-linewise (format "install.packages('%s')\n" pkg))
  977. (signal 'quit nil))))
  978. (define-obsolete-function-alias 'ess-r-sos #'ess-help-web-search "ESS 19.04")
  979. (cl-defmethod ess--help-web-search-override (cmd &context (ess-dialect "R"))
  980. (ess-r-check-install-package "sos")
  981. (ess-eval-linewise (format "sos::findFn(\"%s\", maxPages=10)" cmd)))
  982. (defun ess-R-scan-for-library-call (string)
  983. "Detect `library/require' call in STRING and update tracking vars.
  984. Placed into `ess-presend-filter-functions' for R dialects."
  985. (when (string-match-p "\\blibrary(\\|\\brequire(" string)
  986. (ess--mark-search-list-as-changed))
  987. string)
  988. (cl-defmethod ess-installed-packages (&context (ess-dialect "R"))
  989. ;;; FIXME? .packages() does not cache; installed.packages() does but is slower first time
  990. (ess-get-words-from-vector "print(.packages(T), max=1e6)\n"))
  991. (cl-defmethod ess-load-library--override (pack &context (ess-dialect "R"))
  992. "Load an R package."
  993. (ess-eval-linewise (format "library('%s')\n" pack)))
  994. (define-obsolete-function-alias 'ess-library 'ess-load-library "ESS[12.09-1]")
  995. ;;; smart-comma was a bad idea
  996. (eval-after-load "eldoc"
  997. '(eldoc-add-command "ess-smart-comma"))
  998. ;;*;; Interaction with R
  999. ;;;*;;; Evaluation
  1000. (defun ess-r-arg (param value &optional wrap)
  1001. (let ((value (if wrap
  1002. (concat "'" value "'")
  1003. value)))
  1004. (concat ", " param " = " value)))
  1005. (defun ess-r-build-args (visibly output namespace)
  1006. (let ((visibly (ess-r-arg "visibly" (if visibly "TRUE" "FALSE")))
  1007. (output (ess-r-arg "output" (if output "TRUE" "FALSE")))
  1008. (pkg (when namespace (ess-r-arg "package" namespace t)))
  1009. (verbose (when (and namespace
  1010. ess-r-namespaced-load-verbose)
  1011. (ess-r-arg "verbose" "TRUE"))))
  1012. (concat visibly output pkg verbose)))
  1013. (cl-defmethod ess-build-eval-command--override (string &context (ess-dialect "R")
  1014. &optional visibly output file &rest args)
  1015. "R method to build eval command."
  1016. (let* ((namespace (caar args))
  1017. (namespace (unless ess-debug-minor-mode
  1018. (or namespace (ess-r-get-evaluation-env))))
  1019. (cmd (if namespace ".ess.ns_eval" ".ess.eval"))
  1020. (file (when file (ess-r-arg "file" file t)))
  1021. (rargs (ess-r-build-args visibly output namespace)))
  1022. (concat cmd "(\"" string "\"" rargs file ")\n")))
  1023. (cl-defmethod ess-build-load-command (string &context (ess-dialect "R")
  1024. &optional visibly output file &rest _args)
  1025. (let* ((namespace (or file (ess-r-get-evaluation-env)))
  1026. (cmd (if namespace ".ess.ns_source" ".ess.source"))
  1027. (rargs (ess-r-build-args visibly output namespace)))
  1028. (concat cmd "('" string "'" rargs ")\n")))
  1029. (defun ess-r-build-eval-message (message)
  1030. (let ((env (cond (ess-debug-minor-mode
  1031. (substring-no-properties ess-debug-indicator 1))
  1032. ((ess-r-get-evaluation-env)))))
  1033. (if env
  1034. (format "[%s] %s" env message)
  1035. message)))
  1036. (defvar-local ess-r-evaluation-env nil
  1037. "Environment into which code should be evaluated.
  1038. When this variable is nil, code is evaluated in the current
  1039. environment. Currently only packages can be set as evaluation
  1040. environments. Use `ess-r-set-evaluation-env' to set this
  1041. variable.")
  1042. (defun ess-r-get-evaluation-env ()
  1043. "Get current evaluation env."
  1044. (or ess-r-evaluation-env
  1045. (and ess-current-process-name
  1046. (ess-get-process-variable 'ess-r-evaluation-env))))
  1047. (defun ess-r-set-evaluation-env (&optional arg)
  1048. "Select a package namespace for evaluation of R code.
  1049. Call interactively with a prefix argument to disable evaluation
  1050. in a namespace. When calling from a function, ARG can be a
  1051. string giving the package to select, any other non-nil value to
  1052. disable, or nil to prompt for a package.
  1053. If `ess-r-prompt-for-attached-pkgs-only' is non-nil, prompt only for
  1054. attached packages."
  1055. (interactive "P")
  1056. (let ((env (cond ((stringp arg) arg)
  1057. ((null arg) (ess-r--select-package-name))
  1058. (t "*none*"))))
  1059. (if (equal env "*none*")
  1060. (let ((cur-env (ess-r-get-evaluation-env)))
  1061. ;; fixme: does not work if env is set at process level
  1062. (setq ess-r-evaluation-env nil)
  1063. (delq 'ess-r--evaluation-env-mode-line ess--local-mode-line-process-indicator)
  1064. (message (format "Evaluation in %s disabled" (propertize cur-env 'face font-lock-function-name-face))))
  1065. (setq ess-r-evaluation-env env)
  1066. (add-to-list 'ess--local-mode-line-process-indicator 'ess-r--evaluation-env-mode-line t)
  1067. (message (format "Evaluating in %s" (propertize env 'face font-lock-function-name-face))))
  1068. (force-mode-line-update)))
  1069. (defvar-local ess-r--evaluation-env-mode-line
  1070. '(:eval (let ((env (ess-r-get-evaluation-env)))
  1071. (if env
  1072. (format " %s"
  1073. (propertize (if (equal env (ess-r-package-name))
  1074. "pkg"
  1075. env)
  1076. 'face 'mode-line-emphasis))
  1077. ""))))
  1078. (put 'ess-r--evaluation-env-mode-line 'risky-local-variable t)
  1079. (defvar ess-r-namespaced-load-only-existing t
  1080. "Whether to load only objects already existing in a namespace.")
  1081. (cl-defmethod ess-load-file--override (file &context (ess-dialect "R"))
  1082. (cond
  1083. ;; Namespaced evaluation
  1084. ((ess-r-get-evaluation-env)
  1085. (ess-r-load-file-namespaced file))
  1086. ;; Evaluation into current env via .ess.source()
  1087. (t
  1088. (let ((command (ess-build-load-command file nil t)))
  1089. (ess-send-string (ess-get-process) command)))))
  1090. (defun ess-r-load-file-namespaced (&optional file)
  1091. "Load FILE into a package namespace.
  1092. This prompts for a package when no package is currently
  1093. selected (see `ess-r-set-evaluation-env')."
  1094. (ess-force-buffer-current "R process to use: ")
  1095. (let* ((pkg-name (ess-r-get-evaluation-env))
  1096. (command (ess-build-load-command file nil t pkg-name)))
  1097. (ess-send-string (ess-get-process) command)))
  1098. (cl-defmethod ess-send-region--override (process start end visibly message type
  1099. &context (ess-dialect "R"))
  1100. (cond
  1101. ;; Namespaced evaluation
  1102. ((ess-r-get-evaluation-env)
  1103. (ess-r-send-region-namespaced process start end visibly message))
  1104. ;; Evaluation into current env
  1105. (t
  1106. (ess-send-string process (buffer-substring start end) visibly message type))))
  1107. (defun ess-r-send-region-namespaced (proc start end &optional visibly message)
  1108. "Ask for for the package and devSource region into it."
  1109. (or (ess-r-get-evaluation-env)
  1110. (ess-r-set-evaluation-env))
  1111. (message (ess-r-build-eval-message (or message "Eval region")))
  1112. (ess-send-string proc (buffer-substring start end) visibly message))
  1113. ;;;*;;; Help
  1114. (defun ess-r-namespaced-object-p (object)
  1115. (string-match "^[[:alnum:].]+::" object))
  1116. (defun ess-r-build-help-command--qualified (object)
  1117. (when (ess-r-namespaced-object-p object)
  1118. (let* ((pkg-name (substring object (match-beginning 0) (- (match-end 0) 2)))
  1119. (object (concat "'" (substring object (match-end 0)) "'"))
  1120. (pkg (ess-r-arg "package" pkg-name t)))
  1121. (concat ".ess.help(" object pkg ")\n"))))
  1122. (defun ess-r-build-help-command--get-package-dir (object)
  1123. ;; Ugly hack to avoid tcl/tk dialogues
  1124. (let ((pkgs (ess-get-words-from-vector
  1125. (format "as.character(utils::help('%s'))\n" object))))
  1126. (when (> (length pkgs) 1)
  1127. (ess-completing-read "Choose location" pkgs nil t))))
  1128. (defun ess-r-build-help-command--unqualified (object)
  1129. (if (eq ess-help-type 'index)
  1130. ;; we are in index page, qualify with namespace
  1131. (ess-r-build-help-command--qualified (format "%s::%s" ess-help-object object))
  1132. (let ((pkg-dir (ess-r-build-help-command--get-package-dir object))
  1133. (command (format inferior-ess-r-help-command object)))
  1134. (if pkg-dir
  1135. ;; Invoking `print.help_files_with_topic'
  1136. (format "do.call(structure, c('%s', attributes(%s)))\n" pkg-dir command)
  1137. command))))
  1138. (cl-defmethod ess-build-help-command (object &context (ess-dialect "R"))
  1139. (or (ess-r-build-help-command--qualified object)
  1140. (ess-r-build-help-command--unqualified object)))
  1141. (defconst inferior-ess-r--input-help (format "^ *help *(%s)" ess-help-arg-regexp))
  1142. (defconst inferior-ess-r--input-?-help-regexp "^ *\\(?:\\(?1:[a-zA-Z ]*?\\?\\{1,2\\}\\) *\\(?2:.+\\)\\)")
  1143. (defconst inferior-ess-r--page-regexp (format "^ *page *(%s)" ess-help-arg-regexp))
  1144. (defun ess-help-r--process-help-input (proc string)
  1145. (let ((help-match (and (string-match inferior-ess-r--input-help string)
  1146. (match-string 2 string)))
  1147. (help-?-match (and (string-match inferior-ess-r--input-?-help-regexp string)
  1148. string))
  1149. (page-match (and (string-match inferior-ess-r--page-regexp string)
  1150. (match-string 2 string))))
  1151. (when (or help-match help-?-match page-match)
  1152. (cond (help-match
  1153. (ess-display-help-on-object help-match)
  1154. (process-send-string proc "\n"))
  1155. (help-?-match
  1156. (ess-help-r--display-help-? string help-?-match)
  1157. (process-send-string proc "\n"))
  1158. (page-match
  1159. (switch-to-buffer-other-window
  1160. (ess-command (concat page-match "\n")
  1161. (get-buffer-create (concat page-match ".rt"))))
  1162. (ess-r-transcript-mode)
  1163. (process-send-string proc "\n")))
  1164. t)))
  1165. (defun ess-help-r--display-help-? (string help-?-match)
  1166. (cond ((string-match "\\?\\?\\(.+\\)" help-?-match)
  1167. (ess--display-indexed-help-page (concat help-?-match "\n")
  1168. "^\\([^ \t\n]+::[^ \t\n]+\\)[ \t\n]+"
  1169. (format "*ess-apropos[%s](%s)*"
  1170. ess-current-process-name (match-string 1 help-?-match))
  1171. 'appropos))
  1172. ((string-match "^ *\\? *\\([^ \t]+\\)$" help-?-match)
  1173. (ess-display-help-on-object (match-string 1 help-?-match)))
  1174. ;; Anything else we send to process almost unchanged
  1175. (t
  1176. (let ((help-?-match (and (string-match inferior-ess-r--input-?-help-regexp string)
  1177. (format "%s%s" (match-string 1 string)
  1178. (ess-help-r--sanitize-topic (match-string 2 string))))))
  1179. (ess-display-help-on-object help-?-match "%s\n")))))
  1180. (defun ess-help-r--sanitize-topic (string)
  1181. "Enclose help topic STRING into `` to avoid ?while ?if etc hangs."
  1182. (if (string-match "\\([^:]*:+\\)\\(.*\\)$" string) ; treat foo::bar correctly
  1183. (format "%s`%s`" (match-string 1 string) (match-string 2 string))
  1184. (format "`%s`" string)))
  1185. ;;;*;;; Utils for inferior R process
  1186. (defun inferior-ess-r-input-sender (proc string)
  1187. (save-current-buffer
  1188. (or (ess-help-r--process-help-input proc string)
  1189. (inferior-ess-input-sender proc string))))
  1190. (defun ess-r-load-ESSR ()
  1191. "Load ESSR functionality."
  1192. (cond
  1193. ((file-remote-p (ess-get-process-variable 'default-directory))
  1194. (if (eq ess-r-fetch-ESSR-on-remotes t)
  1195. (ess-r--fetch-ESSR-remote)
  1196. (ess-r--load-ESSR-remote)))
  1197. ((and (bound-and-true-p ess-remote))
  1198. (if ess-r-fetch-ESSR-on-remotes
  1199. (ess-r--fetch-ESSR-remote)
  1200. (ess-r--load-ESSR-remote t)))
  1201. (t (ess-r--load-ESSR-local))))
  1202. (defun ess-r--load-ESSR-local ()
  1203. (let* ((src-dir (expand-file-name "ESSR/R" ess-etc-directory))
  1204. (cmd (format "local({
  1205. source('%s/.load.R', local=TRUE) #define load.ESSR
  1206. .ess.load.ESSR('%s')
  1207. })\n"
  1208. src-dir src-dir)))
  1209. (with-current-buffer (ess-command cmd)
  1210. (let ((msg (buffer-string)))
  1211. (when (> (length msg) 1)
  1212. (message (format "Messages while loading ESSR: %s" msg)))))))
  1213. (defun ess-r--load-ESSR-remote (&optional chunked)
  1214. (ess-command (format ".ess.ESSRversion <- '%s'\n" essr-version))
  1215. (with-temp-message "Loading ESSR into remote ..."
  1216. (let ((src-dir (expand-file-name "ESSR/R" ess-etc-directory)))
  1217. (dolist (file (directory-files src-dir t "\\.R$"))
  1218. (ess--inject-code-from-file file chunked)))))
  1219. (defun ess-r--fetch-ESSR-remote ()
  1220. (let ((loader (ess-file-content (expand-file-name "ESSR/LOADREMOTE" ess-etc-directory))))
  1221. (unless (ess-boolean-command (format loader essr-version) nil 0.1)
  1222. (let* ((errmsg (with-current-buffer " *ess-command-output*" (buffer-string)))
  1223. (src-dir (expand-file-name "ESSR/R" ess-etc-directory))
  1224. (files (directory-files src-dir t "\\.R$")))
  1225. (message (format "Couldn't load ESSR.rds. Injecting from local.\n Error: %s\n" errmsg))
  1226. (ess-r--load-ESSR-remote)))))
  1227. (cl-defmethod ess-quit--override (arg &context (ess-dialect "R"))
  1228. "With ARG, do not offer to save the workspace."
  1229. (let ((cmd (format "base::q('%s')\n" (if arg "no" "default")))
  1230. (sprocess (ess-get-process ess-current-process-name)))
  1231. (when (not sprocess) (error "No ESS process running"))
  1232. (ess-cleanup)
  1233. (ess-send-string sprocess cmd t)))
  1234. (defcustom inferior-ess-r-reload-hook nil
  1235. "Hook run when reloading the R inferior buffer."
  1236. :type 'hook
  1237. :group 'ess-R)
  1238. (cl-defmethod inferior-ess-reload--override (start-name start-args &context (ess-dialect "R"))
  1239. "Call `run-ess-r' with START-ARGS.
  1240. Then run `inferior-ess-r-reload-hook'."
  1241. (let ((inferior-ess-r-program start-name))
  1242. (run-ess-r start-args))
  1243. (run-hooks 'inferior-ess-r-reload-hook))
  1244. (defun inferior-ess-r-force (&optional prompt force no-autostart ask-if-1)
  1245. (setq-local ess-dialect "R")
  1246. (ess-force-buffer-current prompt force no-autostart ask-if-1))
  1247. ;;*;; Editing Tools
  1248. ;;;*;;; Indentation Engine
  1249. ;; Written by Lionel Henry in mid 2015
  1250. (defun ess-r-indent-line ()
  1251. "Indent current line as ESS R code.
  1252. Return the amount the indentation changed by."
  1253. (when-let ((indent (ess-calculate-indent)))
  1254. (let ((case-fold-search nil)
  1255. (pos (- (point-max) (point)))
  1256. beg shift-amt)
  1257. (beginning-of-line)
  1258. (setq beg (point))
  1259. (skip-chars-forward " \t")
  1260. (setq shift-amt (- indent (current-column)))
  1261. (if (zerop shift-amt)
  1262. (if (> (- (point-max) pos) (point))
  1263. (goto-char (- (point-max) pos)))
  1264. (delete-region beg (point))
  1265. (indent-to indent)
  1266. ;; If initial point was within line's indentation,
  1267. ;; position after the indentation.
  1268. ;; Else stay at same point in text.
  1269. (when (> (- (point-max) pos) (point))
  1270. (goto-char (- (point-max) pos))))
  1271. shift-amt)))
  1272. (defun ess-r-indent-exp ()
  1273. (save-excursion
  1274. (when current-prefix-arg
  1275. (ess-climb-to-top-level))
  1276. (let* ((bounds (ess-continuations-bounds))
  1277. (end (cadr bounds))
  1278. (beg (if current-prefix-arg
  1279. (car bounds)
  1280. (forward-line)
  1281. (point))))
  1282. (indent-region beg end))))
  1283. (defun ess-indent-call (&optional start)
  1284. (save-excursion
  1285. (when (ess-escape-calls)
  1286. (setq start (or start (point)))
  1287. (skip-chars-forward "^[(")
  1288. (forward-char)
  1289. (ess-up-list)
  1290. (indent-region start (point)))))
  1291. (defun ess-offset (offset)
  1292. (setq offset (eval (intern (concat "ess-offset-" (symbol-name offset)))))
  1293. (when (and (not (eq offset nil))
  1294. (listp offset)
  1295. (or (numberp (cadr offset))
  1296. (eq (cadr offset) t)
  1297. (error "Malformed offset")))
  1298. (setq offset (cadr offset)))
  1299. (cond ((numberp offset)
  1300. offset)
  1301. ((null offset)
  1302. 0)
  1303. (t
  1304. ess-indent-offset)))
  1305. (defun ess-offset-type (offset)
  1306. (setq offset (eval (intern (concat "ess-offset-" (symbol-name offset)))))
  1307. (if (listp offset)
  1308. (car offset)
  1309. offset))
  1310. (defun ess-overridden-blocks ()
  1311. (append (when (memq 'fun-decl ess-align-blocks)
  1312. (list (car ess-prefixed-block-patterns)))
  1313. (when (memq 'control-flow ess-align-blocks)
  1314. (append (cdr ess-prefixed-block-patterns)
  1315. '("}?[ \t]*else")))))
  1316. (defun ess-calculate-indent ()
  1317. "Return appropriate indentation for current line as ESS code.
  1318. In usual case returns an integer: the column to indent to.
  1319. Returns nil if line starts inside a string, t if in a comment."
  1320. (save-excursion
  1321. (beginning-of-line)
  1322. (let* ((indent-point (point))
  1323. (state (syntax-ppss))
  1324. (containing-sexp (cadr state))
  1325. (prev-containing-sexp (car (last (butlast (nth 9 state))))))
  1326. (back-to-indentation)
  1327. (cond
  1328. ;; Strings
  1329. ((ess-inside-string-p)
  1330. (current-indentation))
  1331. ;; Comments
  1332. ((ess-calculate-indent--comments))
  1333. ;; Indentation of commas
  1334. ((looking-at ",")
  1335. (ess-calculate-indent--comma))
  1336. ;; Arguments: Closing
  1337. ((ess-call-closing-p)
  1338. (ess-calculate-indent--call-closing-delim))
  1339. ;; Block: Contents (easy cases)
  1340. ((ess-calculate-indent--block-relatively))
  1341. ;; Block: Prefixed block
  1342. ((ess-calculate-indent--prefixed-block-curly))
  1343. ;; Continuations
  1344. ((ess-calculate-indent--continued))
  1345. ;; Block: Overridden contents
  1346. ((ess-calculate-indent--aligned-block))
  1347. ;; Block: Opening
  1348. ((ess-block-opening-p)
  1349. (ess-calculate-indent--block-opening))
  1350. ;; Bare line
  1351. ((and (null containing-sexp)
  1352. (not (ess-unbraced-block-p)))
  1353. 0)
  1354. ;; Block: Closing
  1355. ((ess-block-closing-p)
  1356. (ess-calculate-indent--block 0))
  1357. ;; Block: Contents
  1358. ((ess-block-p)
  1359. (ess-calculate-indent--block))
  1360. ;; Arguments: Nested calls override
  1361. ((ess-calculate-indent--nested-calls))
  1362. ;; Arguments: Contents
  1363. (t
  1364. (ess-calculate-indent--args))))))
  1365. (defun ess-calculate-indent--comments ()
  1366. (when ess-indent-with-fancy-comments
  1367. (cond
  1368. ;; ### or #!
  1369. ((or (looking-at "###")
  1370. (and (looking-at "#!")
  1371. (= 1 (line-number-at-pos))))
  1372. 0)
  1373. ;; Single # comment
  1374. ((looking-at "#[^#']")
  1375. comment-column))))
  1376. (defun ess-calculate-indent--comma ()
  1377. (when (ess-inside-call-p)
  1378. (let ((indent (save-excursion
  1379. (ess-calculate-indent--args)))
  1380. (unindent (progn (skip-chars-forward " \t")
  1381. ;; return number of skipped chars
  1382. (skip-chars-forward ", \t"))))
  1383. (- indent unindent))))
  1384. (defun ess-calculate-indent--call-closing-delim ()
  1385. (cond ((save-excursion
  1386. (ess-skip-blanks-backward t)
  1387. (eq (char-before) ?,))
  1388. (ess-calculate-indent--args nil))
  1389. ((save-excursion
  1390. (and (ess-ahead-operator-p)
  1391. (or (ess-ahead-definition-op-p)
  1392. (not ess-align-continuations-in-calls))))
  1393. (ess-calculate-indent--continued))
  1394. (t
  1395. (ess-calculate-indent--args 0))))
  1396. (defun ess-calculate-indent--block-opening ()
  1397. (cond
  1398. ;; Block is an argument in a function call
  1399. ((when containing-sexp
  1400. (ess-at-containing-sexp
  1401. (ess-behind-call-opening-p "[[(]")))
  1402. (ess-calculate-indent--block 0))
  1403. ;; Top-level block
  1404. ((null containing-sexp) 0)
  1405. ;; Block is embedded in another block
  1406. ((ess-at-containing-sexp
  1407. (+ (current-indentation)
  1408. (ess-offset 'block))))))
  1409. (defun ess-calculate-indent--aligned-block ()
  1410. ;; Check for `else' opening
  1411. (if (and (memq 'control-flow ess-align-blocks)
  1412. (looking-at "else\\b")
  1413. (ess-climb-if-else))
  1414. (progn
  1415. (when (looking-at "else\\b")
  1416. (ess-skip-curly-backward))
  1417. (current-column))
  1418. ;; Check for braced and unbraced blocks
  1419. (ess-save-excursion-when-nil
  1420. (let ((offset (if (looking-at "[{})]")
  1421. 0 (ess-offset 'block))))
  1422. (when (and (cond
  1423. ;; Unbraced blocks
  1424. ((ess-climb-block-prefix))
  1425. ;; Braced blocks
  1426. (containing-sexp
  1427. (when (ess-at-containing-sexp
  1428. (looking-at "{"))
  1429. (ess-escape-prefixed-block))))
  1430. (cl-some 'looking-at
  1431. (ess-overridden-blocks)))
  1432. (+ (current-column) offset))))))
  1433. (defun ess-calculate-indent--block-relatively ()
  1434. (ess-save-excursion-when-nil
  1435. (let ((offset (if (looking-at "[})]") 0 (ess-offset 'block)))
  1436. (start-line (line-number-at-pos)))
  1437. (cond
  1438. ;; Braceless block continuations: only when not in a call
  1439. ((ess-save-excursion-when-nil
  1440. (and (not (looking-at "{"))
  1441. (ess-goto-char (ess-unbraced-block-p))
  1442. (not (looking-at "function\\b"))
  1443. (or (null containing-sexp)
  1444. (ess-at-containing-sexp
  1445. (not (looking-at "("))))))
  1446. (ess-maybe-climb-broken-else 'same-line)
  1447. (ess-skip-curly-backward)
  1448. (+ (current-column)
  1449. (ess-offset 'block)))
  1450. ;; Don't indent relatively other continuations
  1451. ((ess-ahead-continuation-p)
  1452. nil)
  1453. ;; If a block already contains an indented line, we can indent
  1454. ;; relatively from that first line
  1455. ((ess-save-excursion-when-nil
  1456. (and (not (looking-at "}"))
  1457. containing-sexp
  1458. (goto-char containing-sexp)
  1459. (looking-at "{")
  1460. (progn
  1461. (forward-line)
  1462. (back-to-indentation)
  1463. (/= (line-number-at-pos) start-line))
  1464. (not (looking-at "[ \t]*\\(#\\|$\\)"))
  1465. (save-excursion
  1466. (or (ess-jump-expression)
  1467. (ess-jump-continuations))
  1468. (< (line-number-at-pos) start-line))))
  1469. (current-column))
  1470. ;; If a block is not part of a call, we can indent relatively
  1471. ;; from the opening {. First check that enclosing { is first
  1472. ;; thing on line
  1473. ((and containing-sexp
  1474. (not (ess-unbraced-block-p))
  1475. (goto-char containing-sexp)
  1476. (ess-block-opening-p)
  1477. (equal (point) (save-excursion
  1478. (back-to-indentation)
  1479. (point))))
  1480. (+ (current-column) offset))))))
  1481. (defun ess-arg-block-p ()
  1482. (unless (or (null containing-sexp)
  1483. ;; Unbraced blocks in a { block are not arg blocks
  1484. (and (ess-unbraced-block-p)
  1485. (ess-at-containing-sexp
  1486. (looking-at "{"))))
  1487. (cond
  1488. ;; Unbraced body
  1489. ((ess-at-indent-point
  1490. (and (ess-unbraced-block-p)
  1491. (goto-char containing-sexp)
  1492. (ess-behind-call-opening-p "[[(]")))
  1493. 'body)
  1494. ;; Indentation of opening brace as argument
  1495. ((ess-at-containing-sexp
  1496. (ess-behind-call-opening-p "[[(]"))
  1497. 'opening)
  1498. ;; Indentation of body or closing brace as argument
  1499. ((ess-at-containing-sexp
  1500. (and (or (looking-at "{")
  1501. (ess-behind-block-paren-p))
  1502. prev-containing-sexp
  1503. (goto-char prev-containing-sexp)
  1504. (ess-behind-call-opening-p "[[(]")))
  1505. 'body))))
  1506. (defun ess-calculate-indent--block (&optional offset)
  1507. (let ((arg-block (ess-arg-block-p)))
  1508. (cond (arg-block
  1509. (ess-calculate-indent--arg-block offset arg-block))
  1510. (t
  1511. ;; Block is not part of an arguments list. Climb over any
  1512. ;; block opening (function declaration, etc) to indent from
  1513. ;; starting indentation.
  1514. (or (ess-climb-block-prefix)
  1515. (and (goto-char containing-sexp)
  1516. (ess-climb-block-prefix)))
  1517. (+ (current-indentation) (or offset (ess-offset 'block)))))))
  1518. (defun ess-calculate-indent--arg-block (offset arg-block)
  1519. (let* ((block-type (cond ((or (ess-at-containing-sexp
  1520. (and (eq arg-block 'body)
  1521. (ess-climb-block-prefix "function")))
  1522. (ess-at-indent-point
  1523. (and (eq arg-block 'opening)
  1524. (ess-backward-sexp 2)
  1525. (looking-at "function\\b"))))
  1526. 'fun-decl)
  1527. ((ess-at-indent-point
  1528. (ess-unbraced-block-p))
  1529. 'unbraced)
  1530. ((ess-at-containing-sexp
  1531. (not (ess-ahead-attached-name-p)))
  1532. 'bare-block)
  1533. (t)))
  1534. (call-pos (if (and (not (eq block-type 'unbraced))
  1535. (not (eq arg-block 'opening)))
  1536. (goto-char prev-containing-sexp)
  1537. (prog1 containing-sexp
  1538. (goto-char indent-point)))))
  1539. (ess-calculate-indent--args offset (ess-offset-type 'block)
  1540. call-pos indent-point block-type)))
  1541. ;; This function is currently the speed bottleneck of the indentation
  1542. ;; engine. This is due to the need to call (ess-maximum-args-indent)
  1543. ;; to check if some previous arguments have been pushed off from their
  1544. ;; natural indentation: we need to check the whole call. This is very
  1545. ;; inefficient especially when indenting a region containing a large
  1546. ;; function call (e.g. some dplyr's data cleaning code). Should be
  1547. ;; solved by implementing a cache as in (syntax-ppss), though it's
  1548. ;; probably not worth the work.
  1549. (defun ess-calculate-indent--args (&optional offset type call-pos to block)
  1550. (let* ((call-pos (or call-pos containing-sexp))
  1551. (max-col (prog1 (unless (eq type 'prev-line)
  1552. (ess-maximum-args-indent call-pos to))
  1553. (goto-char call-pos)))
  1554. (override (and ess-align-arguments-in-calls
  1555. (save-excursion
  1556. (ess-climb-object)
  1557. (cl-some 'looking-at
  1558. ess-align-arguments-in-calls))))
  1559. (type-sym (cond (block 'block)
  1560. ((looking-at "[[:blank:]]*[([][[:blank:]]*\\($\\|#\\)")
  1561. 'arguments-newline)
  1562. (t 'arguments)))
  1563. (type (or type
  1564. (and override 'open-delim)
  1565. (ess-offset-type type-sym)))
  1566. (offset (or offset
  1567. (and (not block) (eq type 'open-delim) 0)
  1568. (ess-offset type-sym)))
  1569. (indent
  1570. (cond
  1571. ;; Indent from opening delimiter
  1572. ((eq type 'open-delim)
  1573. (ess-calculate-indent--args-open-delim))
  1574. ;; Indent from attached name
  1575. ((eq type 'prev-call)
  1576. (ess-calculate-indent--args-prev-call))
  1577. ;; Indent from previous line indentation
  1578. ((eq type 'prev-line)
  1579. (ess-calculate-indent--args-prev-line))
  1580. (t
  1581. (error "Malformed offset")))))
  1582. (if max-col
  1583. (ess-adjust-argument-indent indent offset max-col block)
  1584. (+ indent offset))))
  1585. (defun ess-calculate-indent--args-open-delim ()
  1586. (forward-char)
  1587. (current-column))
  1588. (defun ess-calculate-indent--args-prev-call ()
  1589. ;; Handle brackets chains such as ][ (cf data.table)
  1590. (ess-climb-chained-delims)
  1591. ;; Handle call chains
  1592. (if ess-indent-from-chain-start
  1593. (while (and (ess-backward-sexp)
  1594. (when (looking-back "[[(][ \t,]*" (line-beginning-position))
  1595. (goto-char (match-beginning 0)))))
  1596. (ess-backward-sexp))
  1597. (when ess-indent-from-lhs
  1598. (ess-climb-lhs))
  1599. (if (and nil
  1600. (eq block 'fun-decl)
  1601. (not (eq arg-block 'opening))
  1602. (not (eq (ess-offset-type type-sym) 'open-delim)))
  1603. (+ (ess-offset 'block) (current-column))
  1604. (current-column)))
  1605. (defun ess-calculate-indent--args-prev-line ()
  1606. (ess-at-indent-point
  1607. (cond
  1608. ;; Closing delimiters are actually not indented at
  1609. ;; prev-line, but at opening-line
  1610. ((looking-at "[]})]")
  1611. (ess-up-list -1)
  1612. (when (looking-at "{")
  1613. (ess-climb-block-prefix))
  1614. (current-indentation))
  1615. ;; Function blocks need special treatment
  1616. ((and (eq type 'prev-line)
  1617. (eq block 'fun-decl))
  1618. (goto-char containing-sexp)
  1619. (ess-climb-block-prefix)
  1620. (current-indentation))
  1621. ;; Regular case
  1622. (t
  1623. ;; Find next non-empty line to indent from
  1624. (while (and (= (forward-line -1) 0)
  1625. (looking-at "[ \t]*\\($\\|#\\)")))
  1626. (goto-char (ess-code-end-position))
  1627. ;; Climb relevant structures
  1628. (unless (ess-climb-block-prefix)
  1629. (when (eq (char-before) ?,)
  1630. (forward-char -1))
  1631. (ess-climb-expression)
  1632. (ess-climb-continuations))
  1633. ;; The following ensures that only the first line
  1634. ;; counts. Otherwise consecutive statements would get
  1635. ;; increasingly more indented.
  1636. (when (and block
  1637. containing-sexp
  1638. (not (eq block 'unbraced))
  1639. (save-excursion
  1640. (/= (line-number-at-pos)
  1641. (progn (goto-char containing-sexp)
  1642. (line-number-at-pos)))))
  1643. (setq offset 0))
  1644. (current-indentation)))))
  1645. ;; Indentation of arguments needs to keep track of how previous
  1646. ;; arguments are indented. If one of those has a smaller indentation,
  1647. ;; we push off the current line from its natural indentation. For
  1648. ;; block arguments, we still need to push off this column so we ignore
  1649. ;; it.
  1650. (defun ess-adjust-argument-indent (base offset max-col push)
  1651. (if push
  1652. (+ (min base max-col) offset)
  1653. (min (+ base offset) max-col)))
  1654. ;; When previous arguments are shifted to the left (can happen in
  1655. ;; several situations) compared to their natural indentation, the
  1656. ;; following lines should not get indented past them. The following
  1657. ;; function checks the minimum indentation for all arguments of the
  1658. ;; current function call or bracket indexing.
  1659. (defun ess-maximum-args-indent (&optional from to)
  1660. (let* ((to (or to (point)))
  1661. (to-line (line-number-at-pos to))
  1662. (from-line (progn
  1663. (goto-char (1+ (or from containing-sexp)))
  1664. (line-number-at-pos)))
  1665. max-col)
  1666. (while (< (line-number-at-pos) to-line)
  1667. (forward-line)
  1668. (back-to-indentation)
  1669. ;; Ignore the line with the function call, the line to be
  1670. ;; indented, and empty lines.
  1671. (unless (or (>= (line-number-at-pos) to-line)
  1672. (looking-at "[ \t]*\\($\\|#\\)"))
  1673. (let ((indent (cond
  1674. ;; First line: minimum indent is right after (
  1675. ((= (line-number-at-pos) from-line)
  1676. (save-excursion
  1677. (goto-char (1+ containing-sexp))
  1678. (current-column)))
  1679. ;; Handle lines starting with a comma
  1680. ((save-excursion
  1681. (looking-at ","))
  1682. (+ (current-indentation) 2))
  1683. (t
  1684. (current-indentation)))))
  1685. (setq max-col (min indent (or max-col indent))))))
  1686. max-col))
  1687. ;; Move to leftmost side of a call (either the first letter of its
  1688. ;; name or its closing delim)
  1689. (defun ess-move-to-leftmost-side ()
  1690. (when (or (looking-at "[({]")
  1691. (ess-behind-call-p))
  1692. (ess-save-excursion-when-nil
  1693. (let ((start-col (current-column)))
  1694. (skip-chars-forward "^{[(")
  1695. (forward-char)
  1696. (ess-up-list)
  1697. (forward-char -1)
  1698. (< (current-column) start-col)))))
  1699. (defun ess-max-col ()
  1700. (let ((max-col (point)))
  1701. (save-excursion
  1702. (while (< (point) indent-point)
  1703. (unless (and ess-indent-with-fancy-comments
  1704. (looking-at "### "))
  1705. (setq max-col (min max-col (current-column))))
  1706. (forward-line)
  1707. (back-to-indentation)))
  1708. max-col))
  1709. (defun ess-calculate-indent--prefixed-block-curly ()
  1710. (when (looking-at "{")
  1711. (ess-save-excursion-when-nil
  1712. (let ((block-type (ess-climb-block-prefix)))
  1713. (cond ((ess-save-excursion-when-nil
  1714. (and (memq 'fun-decl-opening ess-indent-from-lhs)
  1715. (string= block-type "function")
  1716. (ess-climb-operator)
  1717. (ess-behind-assignment-op-p)
  1718. (ess-climb-expression)))
  1719. (current-column))
  1720. ((= (save-excursion
  1721. (back-to-indentation)
  1722. (point))
  1723. (point))
  1724. (ess-calculate-indent--continued)))))))
  1725. (defun ess-calculate-indent--continued ()
  1726. "If a continuation line, return an indent of this line, otherwise nil."
  1727. (save-excursion
  1728. (let* ((cascade (eq (ess-offset-type 'continued) 'cascade))
  1729. (climbed (ess-climb-continuations cascade))
  1730. max-col)
  1731. (when climbed
  1732. (cond
  1733. ;; Overridden calls
  1734. ((and ess-align-continuations-in-calls
  1735. (not (eq climbed 'def-op))
  1736. containing-sexp
  1737. (save-excursion
  1738. (goto-char containing-sexp)
  1739. (looking-at "[[(]")))
  1740. (setq max-col (ess-max-col))
  1741. (ess-move-to-leftmost-side)
  1742. (+ (min (current-column) max-col)
  1743. (if (eq climbed 'def-op)
  1744. (ess-offset 'continued)
  1745. 0)))
  1746. ;; Regular case
  1747. (t
  1748. (let ((first-indent (or (eq climbed 'def-op)
  1749. (save-excursion
  1750. (when (ess-ahead-closing-p)
  1751. (ess-climb-expression))
  1752. (not (ess-climb-continuations cascade))))))
  1753. ;; Record all indentation levels between indent-point and
  1754. ;; the line we climbed. Some lines may have been pushed off
  1755. ;; their natural indentation. These become the new
  1756. ;; reference.
  1757. (setq max-col (ess-max-col))
  1758. ;; Indenting continuations from the front of closing
  1759. ;; delimiters looks better
  1760. (when
  1761. (ess-ahead-closing-p)
  1762. (backward-char))
  1763. (+ (min (current-column) max-col)
  1764. (cond
  1765. ((eq (ess-offset-type 'continued) 'cascade)
  1766. (ess-offset 'continued))
  1767. (first-indent
  1768. (ess-offset 'continued))
  1769. (t
  1770. 0))))))))))
  1771. (defun ess-calculate-indent--nested-calls ()
  1772. (when ess-align-nested-calls
  1773. (let ((calls (mapconcat 'identity ess-align-nested-calls "\\|"))
  1774. match)
  1775. (save-excursion
  1776. (and containing-sexp
  1777. (looking-at (concat "\\(" calls "\\)("))
  1778. (setq match (match-string 1))
  1779. (goto-char containing-sexp)
  1780. (looking-at "(")
  1781. (ess-backward-sexp)
  1782. (looking-at (concat match "("))
  1783. (current-column))))))
  1784. ;;;*;;; Call filling engine
  1785. ;; Unroll arguments to a single line until closing marker is found.
  1786. (defun ess-fill--unroll-lines (bounds &optional jump-cont)
  1787. (let* ((last-pos (point-min))
  1788. (containing-sexp (ess-containing-sexp-position))
  1789. prefix-break)
  1790. (goto-char (car bounds))
  1791. (goto-char (ess-code-end-position))
  1792. (while (and (/= (point) last-pos)
  1793. (< (line-end-position)
  1794. (cadr bounds))
  1795. (not prefix-break))
  1796. (setq last-pos (point))
  1797. ;; Check whether we ended up in a sub call. In this case, jump
  1798. ;; over it, otherwise, join lines.
  1799. (let ((contained-sexp (ess-containing-sexp-position)))
  1800. (cond ((and contained-sexp
  1801. containing-sexp
  1802. (not (= containing-sexp contained-sexp)))
  1803. (goto-char (1+ contained-sexp))
  1804. (ess-up-list))
  1805. ;; Jump over continued statements
  1806. ((and jump-cont (ess-ahead-operator-p 'strict))
  1807. (ess-climb-token)
  1808. (ess-jump-continuations))
  1809. ;; Jump over comments
  1810. ((looking-at "#")
  1811. (forward-line)
  1812. (funcall indent-line-function))
  1813. (t
  1814. (join-line 1))))
  1815. (goto-char (ess-code-end-position)))
  1816. (goto-char (car bounds))))
  1817. (defvar ess-fill--orig-pos nil
  1818. "Original position of cursor.")
  1819. (defvar ess-fill--orig-state nil
  1820. "Backup of original code to cycle back to original state.")
  1821. (defvar ess-fill--second-state nil
  1822. "Backup of code produce by very first cycling.
  1823. If this is equal to orig-state, no need to cycle back to original
  1824. state.")
  1825. (defvar ess-fill--style-level nil
  1826. "Filling style used in last cycle.")
  1827. (defun ess-fill--substring (bounds)
  1828. (buffer-substring (car bounds) (marker-position (cadr bounds))))
  1829. ;; Detect repeated commands
  1830. (defun ess-fill-style (type bounds)
  1831. (let ((max-level
  1832. ;; This part will be simpler once we have the style alist
  1833. (cond ((eq type 'calls)
  1834. ;; No third style either when ess-offset-arguments is
  1835. ;; set to 'open-delim, or when ess-fill-calls-newlines
  1836. ;; is nil and no numeric prefix is given
  1837. (if (and (not (eq (ess-offset-type 'arguments)
  1838. 'open-delim))
  1839. (or ess-fill-calls-newlines
  1840. (numberp current-prefix-arg)))
  1841. 3
  1842. 2))
  1843. ((eq type 'continuations)
  1844. 2))))
  1845. (if (not (memq last-command '(fill-paragraph-or-region
  1846. fill-paragraph)))
  1847. (progn
  1848. ;; Record original state on first cycling
  1849. (setq ess-fill--orig-state (ess-fill--substring bounds))
  1850. (setq ess-fill--orig-pos (point))
  1851. (setq ess-fill--second-state nil)
  1852. (setq ess-fill--style-level 1))
  1853. ;; Also record state on second cycling
  1854. (when (and (= ess-fill--style-level 1)
  1855. (null ess-fill--second-state))
  1856. (setq ess-fill--second-state (ess-fill--substring bounds)))
  1857. (cond ((>= ess-fill--style-level max-level)
  1858. (let ((same-last-and-orig (string= (ess-fill--substring bounds)
  1859. ess-fill--orig-state))
  1860. (same-2nd-and-orig (string= ess-fill--orig-state
  1861. ess-fill--second-state)))
  1862. ;; Avoid cycling to the same state twice
  1863. (cond ((and same-last-and-orig
  1864. same-2nd-and-orig)
  1865. (setq ess-fill--style-level 2))
  1866. ((or same-last-and-orig
  1867. same-2nd-and-orig)
  1868. (setq ess-fill--style-level 1))
  1869. (t
  1870. (setq ess-fill--style-level 0)))))
  1871. (ess-fill--style-level
  1872. (setq ess-fill--style-level (1+ ess-fill--style-level))))))
  1873. ess-fill--style-level)
  1874. (defun ess-fill-args (&optional style)
  1875. (let ((start-pos (point-min))
  1876. (bounds (ess-args-bounds 'marker))
  1877. ;; Set undo boundaries manually
  1878. (undo-inhibit-record-point t)
  1879. last-pos last-newline prefix-break
  1880. infinite)
  1881. (when (not bounds)
  1882. (error "Could not find function bounds"))
  1883. (setq style (or style (ess-fill-style 'calls bounds)))
  1884. (if (= style 0)
  1885. (progn
  1886. (delete-region (car bounds) (marker-position (cadr bounds)))
  1887. (insert ess-fill--orig-state)
  1888. ;; Restore the point manually. (save-excursion) wouldn't
  1889. ;; work here because we delete the text rather than just
  1890. ;; modifying it.
  1891. (goto-char ess-fill--orig-pos)
  1892. (message "Back to original formatting"))
  1893. (when ess-blink-refilling
  1894. (ess-blink-region (nth 2 bounds)
  1895. (1+ (marker-position (cadr bounds)))))
  1896. (undo-boundary)
  1897. (save-excursion
  1898. (ess-fill--unroll-lines bounds t)
  1899. (cond
  1900. ;; Some styles start with first argument on a newline
  1901. ((and (memq style '(2 4))
  1902. ess-fill-calls-newlines
  1903. (not (looking-at "[ \t]*#")))
  1904. (newline-and-indent))
  1905. ;; Third level, start a newline after N arguments
  1906. ((and (= style 3)
  1907. (not (looking-at "[ \t]*#")))
  1908. (let ((i (if (numberp current-prefix-arg)
  1909. current-prefix-arg
  1910. 1)))
  1911. (while (and (> i 0)
  1912. (ess-jump-arg)
  1913. (ess-jump-char ","))
  1914. (setq i (1- i))))
  1915. (newline-and-indent)))
  1916. (ess-fill-args--roll-lines)
  1917. ;; Reindent surrounding context
  1918. (ess-indent-call (car bounds)))
  1919. ;; Signal marker for garbage collection
  1920. (set-marker (cadr bounds) nil)
  1921. (undo-boundary))))
  1922. (defun ess-fill-args--roll-lines ()
  1923. (while (and (not (looking-at "[])]"))
  1924. (/= (point) (or last-pos 1))
  1925. (not infinite))
  1926. (setq prefix-break nil)
  1927. ;; Record start-pos as future breaking point to avoid breaking
  1928. ;; at `=' sign
  1929. (while (looking-at "[ \t]*[\n#]")
  1930. (forward-line)
  1931. (back-to-indentation))
  1932. (setq start-pos (point))
  1933. (while (and (< (current-column) fill-column)
  1934. (not (looking-at "[])]"))
  1935. (/= (point) (or last-pos 1))
  1936. ;; Break after one pass if prefix is active
  1937. (not prefix-break))
  1938. (when (memq style '(2 3))
  1939. (setq prefix-break t))
  1940. (ess-jump-token ",")
  1941. (setq last-pos (point))
  1942. ;; Jump expression and any continuations. Reindent all lines
  1943. ;; that were jumped over
  1944. (let ((cur-line (line-number-at-pos))
  1945. end-line)
  1946. (cond ((ess-jump-arg)
  1947. (setq last-newline nil))
  1948. ((ess-token-after= ",")
  1949. (setq last-newline nil)
  1950. (setq last-pos (1- (point)))))
  1951. (save-excursion
  1952. (when (< cur-line (line-number-at-pos))
  1953. (setq end-line (line-number-at-pos))
  1954. (ess-goto-line (1+ cur-line))
  1955. (while (and (<= (line-number-at-pos) end-line)
  1956. (/= (point) (point-max)))
  1957. (funcall indent-line-function)
  1958. (forward-line))))))
  1959. (when (or (>= (current-column) fill-column)
  1960. prefix-break
  1961. ;; Ensures closing delim on a newline
  1962. (and (= style 4)
  1963. (looking-at "[ \t]*[])]")
  1964. (setq last-pos (point))))
  1965. (if (and last-pos (/= last-pos start-pos))
  1966. (goto-char last-pos)
  1967. (ess-jump-char ","))
  1968. (cond ((looking-at "[ \t]*[#\n]")
  1969. (forward-line)
  1970. (funcall indent-line-function)
  1971. (setq last-newline nil))
  1972. ;; With levels 2 and 3, closing delim goes on a newline
  1973. ((looking-at "[ \t]*[])]")
  1974. (when (and (memq style '(2 3 4))
  1975. ess-fill-calls-newlines
  1976. (not last-newline))
  1977. (newline-and-indent)
  1978. ;; Prevent indenting infinitely
  1979. (setq last-newline t)))
  1980. ((not last-newline)
  1981. (newline-and-indent)
  1982. (setq last-newline t))
  1983. (t
  1984. (setq infinite t))))))
  1985. (defun ess-fill-continuations (&optional style)
  1986. (let ((bounds (ess-continuations-bounds 'marker))
  1987. (undo-inhibit-record-point t)
  1988. (last-pos (point-min))
  1989. last-newline infinite)
  1990. (when (not bounds)
  1991. (error "Could not find statements bounds"))
  1992. (setq style (or style (ess-fill-style 'continuations bounds)))
  1993. (if (= style 0)
  1994. (progn
  1995. (delete-region (car bounds) (marker-position (cadr bounds)))
  1996. (insert ess-fill--orig-state)
  1997. (goto-char ess-fill--orig-pos)
  1998. (message "Back to original formatting"))
  1999. (when ess-blink-refilling
  2000. (ess-blink-region (car bounds) (marker-position (cadr bounds))))
  2001. (undo-boundary)
  2002. (save-excursion
  2003. (ess-fill--unroll-lines bounds)
  2004. (while (and (< (point) (cadr bounds))
  2005. (/= (point) (or last-pos 1))
  2006. (not infinite))
  2007. (setq last-pos (point))
  2008. (when (and (ess-jump-expression)
  2009. (indent-according-to-mode)
  2010. (not (> (current-column) fill-column)))
  2011. (setq last-newline nil))
  2012. (ess-jump-operator)
  2013. (if (or (and (> (current-column) fill-column)
  2014. (goto-char last-pos))
  2015. (= style 2))
  2016. (progn
  2017. (ess-jump-operator)
  2018. (unless (= (point) (cadr bounds))
  2019. (when last-newline
  2020. (setq infinite t))
  2021. (newline-and-indent)
  2022. (setq last-newline t)))
  2023. (setq last-newline nil)))
  2024. (ess-indent-call (car bounds)))
  2025. (set-marker (cadr bounds) nil)
  2026. (undo-boundary))))
  2027. ;;;*;;; Inferior R mode
  2028. (defvar inferior-ess-r-mode-map
  2029. (let ((map (make-sparse-keymap)))
  2030. (define-key map "\M-\r" #'ess-dirs)
  2031. (define-key map (kbd "C-c C-=") #'ess-cycle-assign)
  2032. (define-key map (kbd "C-c C-.") 'ess-rutils-map)
  2033. map)
  2034. "Keymap for `inferior-ess-r-mode'.")
  2035. ;; TOTHINK: Prevent string delimiting characters from messing up output in the
  2036. ;; inferior buffer
  2037. (defvar inferior-ess-r-mode-syntax-table
  2038. (let ((table (copy-syntax-table ess-r-mode-syntax-table)))
  2039. (modify-syntax-entry ?% "." table)
  2040. (modify-syntax-entry ?\' "." table)
  2041. table)
  2042. "Syntax table for `inferior-ess-r-mode'.")
  2043. (define-derived-mode inferior-ess-r-mode inferior-ess-mode "iESS"
  2044. "Major mode for interacting with inferior R processes."
  2045. :group 'ess-proc
  2046. (ess-setq-vars-local ess-r-customize-alist)
  2047. (setq-local ess-font-lock-keywords 'inferior-ess-r-font-lock-keywords)
  2048. (setq-local comint-process-echoes (eql ess-eval-visibly t))
  2049. (setq-local comint-prompt-regexp inferior-S-prompt)
  2050. (setq comint-input-sender 'inferior-ess-r-input-sender)
  2051. (remove-hook 'completion-at-point-functions 'ess-filename-completion 'local) ;; should be first
  2052. (add-hook 'completion-at-point-functions 'ess-r-object-completion nil 'local)
  2053. (add-hook 'completion-at-point-functions 'ess-filename-completion nil 'local)
  2054. (add-hook 'xref-backend-functions #'ess-r-xref-backend nil 'local)
  2055. ;; eldoc
  2056. (add-function :before-until (local 'eldoc-documentation-function)
  2057. #'ess-r-eldoc-function)
  2058. (when ess-use-eldoc (eldoc-mode))
  2059. ;; auto-complete
  2060. (ess--setup-auto-complete ess-r-ac-sources t)
  2061. ;; company
  2062. (ess--setup-company ess-r-company-backends t)
  2063. (setq comint-get-old-input #'inferior-ess-get-old-input)
  2064. (add-hook 'comint-input-filter-functions 'ess-search-path-tracker nil 'local))
  2065. ;;;*;;; R Help mode
  2066. (defvar ess-r-help-mode-map
  2067. (let ((map (make-sparse-keymap)))
  2068. (set-keymap-parent map (make-composed-keymap button-buffer-map
  2069. ess-help-mode-map))
  2070. (define-key map "s<" #'beginning-of-buffer)
  2071. (define-key map "s>" #'end-of-buffer)
  2072. (define-key map "sa" #'ess-skip-to-help-section)
  2073. (define-key map "sd" #'ess-skip-to-help-section)
  2074. (define-key map "sD" #'ess-skip-to-help-section)
  2075. (define-key map "st" #'ess-skip-to-help-section)
  2076. (define-key map "se" #'ess-skip-to-help-section)
  2077. (define-key map "sn" #'ess-skip-to-help-section)
  2078. (define-key map "sr" #'ess-skip-to-help-section)
  2079. (define-key map "ss" #'ess-skip-to-help-section)
  2080. (define-key map "su" #'ess-skip-to-help-section)
  2081. (define-key map "sv" #'ess-skip-to-help-section)
  2082. map)
  2083. "Keymap for `ess-r-help-mode'.")
  2084. (cl-defmethod ess--help-major-mode (&context (ess-dialect "R"))
  2085. (ess-r-help-mode))
  2086. (define-derived-mode ess-r-help-mode ess-help-mode "R Help"
  2087. "Major mode for help buffers."
  2088. :group 'ess-help
  2089. (setq ess-dialect "R"
  2090. ess-help-sec-regex ess-help-r-sec-regex
  2091. ess-help-sec-keys-alist ess-help-r-sec-keys-alist ; TODO: Still necessary?
  2092. inferior-ess-help-command inferior-ess-r-help-command)
  2093. (ess-r-help-add-links))
  2094. (defun ess-r-help-usage-objects ()
  2095. "Return a list of objects in the usage section for the current help buffer.
  2096. In other words, if in the help buffer for \"qt\", return
  2097. '((\"dt\" \"x\" \"df\" \"ncp\" \"log\")
  2098. (\"pt\" \"q\" \"df\" \"ncp\" \"lower.tail\" \"log.p\")
  2099. (\"qt\" \"p\" \"df\" \"ncp\" \"lower.tail\" \"log.p\")
  2100. (\"rt\" \"n\" \"df\" \"ncp\")).
  2101. If the current buffer does not have a usage section, return nil."
  2102. (unless (derived-mode-p 'ess-r-help-mode)
  2103. (error "Not an R help buffer"))
  2104. (save-excursion
  2105. (save-restriction
  2106. (let (usage-objects)
  2107. (widen)
  2108. (goto-char (point-min))
  2109. ;; Narrow the buffer to just the "Usage" section
  2110. (when-let ((usage-beg (re-search-forward "^Usage:" nil t))
  2111. (usage-end (re-search-forward "^[^[:space:]]" nil t)))
  2112. (forward-line -1)
  2113. (narrow-to-region usage-beg (point))
  2114. (goto-char (point-min))
  2115. ;; Match objects until a parens
  2116. (while (re-search-forward (rx bol (0+ whitespace) (not (syntax comment-delimiter))
  2117. (group (1+ (not (any "(")))))
  2118. usage-end t)
  2119. (push (match-string-no-properties 1) usage-objects)
  2120. ;; Skip past function arguments
  2121. (forward-list)))
  2122. (when usage-objects
  2123. ;; Get arguments:
  2124. (setq usage-objects
  2125. (mapcar (lambda (u) (cons u (ess-get-words-from-vector (concat "names(formals(" u "))\n"))))
  2126. usage-objects)))
  2127. (nreverse usage-objects)))))
  2128. (define-button-type 'ess-r-help-link
  2129. 'follow-link t
  2130. 'action (lambda (_) (ess-r-help-button-action)))
  2131. (defun ess-r-help-button-action ()
  2132. "Display help for button at point."
  2133. (let ((text (get-text-property (point) 'ess-r-help-link-text)))
  2134. (ess-display-help-on-object text)))
  2135. (defun ess-r-help-add-links ()
  2136. "Add links to the help buffer."
  2137. (let ((help-topics (when (ess-process-live-p)
  2138. (ess-help-get-topics ess-local-process-name)))
  2139. (inhibit-read-only t)
  2140. (usage-objects (ess-flatten-list (ess-r-help-usage-objects))))
  2141. (save-excursion
  2142. ;; Search for fancy quotes only. If users have
  2143. ;; options(useFancyQuotes) set to something other than TRUE this
  2144. ;; probably won't work. If it's FALSE, R outputs ascii ', but
  2145. ;; searching through the whole buffer takes too long.
  2146. (while (re-search-forward "\\([^[:space:]]+?\\)’" nil t)
  2147. (let* ((text (match-string 1))
  2148. (text (if (string-match-p ".*()\\'" text)
  2149. (substring text nil (- (length text) 2))
  2150. text)))
  2151. (when (and (member text help-topics)
  2152. (not (member text usage-objects))
  2153. (not (member text usage-objects)))
  2154. (delete-region (match-beginning 0) (match-end 0))
  2155. (insert-text-button text
  2156. 'ess-r-help-link-text text
  2157. 'type 'ess-r-help-link
  2158. 'help-echo (format "mouse-2, RET: Help on %s" text))))))))
  2159. (cl-defmethod ess--display-vignettes-override (all &context (ess-dialect "R"))
  2160. "Display R vignettes in ess-help-like buffer..
  2161. With (prefix) ALL non-nil, use `vignette(*, all=TRUE)`, i.e.,
  2162. from all installed packages, which can be very slow."
  2163. (inferior-ess-r-force)
  2164. (let* ((vslist (with-current-buffer
  2165. (ess-command
  2166. (format ".ess_vignettes(%s)\n" (if all "TRUE" "")))
  2167. (goto-char (point-min))
  2168. (when (re-search-forward "(list" nil t)
  2169. (goto-char (match-beginning 0))
  2170. (ignore-errors (eval (read (current-buffer)))))))
  2171. (proc-name ess-current-process-name)
  2172. (alist ess-local-customize-alist)
  2173. (remote (file-remote-p default-directory))
  2174. (buff (get-buffer-create (format "*[%s]vignettes*" ess-dialect)))
  2175. (inhibit-modification-hooks t)
  2176. (inhibit-read-only t))
  2177. (with-current-buffer buff
  2178. (setq buffer-read-only nil)
  2179. (delete-region (point-min) (point-max))
  2180. (ess-setq-vars-local (eval alist))
  2181. (setq ess-local-process-name proc-name)
  2182. (ess--help-major-mode)
  2183. (setq ess-help-sec-regex "^\\w+:$"
  2184. ess-help-type 'vignettes)
  2185. (set-buffer-modified-p 'nil)
  2186. (goto-char (point-min))
  2187. (dolist (el vslist)
  2188. (let ((pack (car el)))
  2189. (insert (format "\n\n%s:\n\n" (propertize pack 'face 'underline)))
  2190. (dolist (el2 (cdr el))
  2191. (let ((path (if remote
  2192. (with-no-warnings
  2193. ;; Have to wrap this in with-no-warnings because
  2194. ;; otherwise the byte compiler complains about
  2195. ;; calling tramp-make-tramp-file-name with an
  2196. ;; incorrect number of arguments on Both 26+ and 25 emacses.
  2197. (if (>= emacs-major-version 26)
  2198. (with-parsed-tramp-file-name default-directory nil
  2199. (tramp-make-tramp-file-name method user domain host port (nth 1 el2)))
  2200. (with-parsed-tramp-file-name default-directory nil
  2201. (tramp-make-tramp-file-name method user host (nth 1 el2)))))
  2202. (nth 1 el2))))
  2203. (insert-text-button "Pdf"
  2204. 'mouse-face 'highlight
  2205. 'action (if remote
  2206. #'ess--action-open-in-emacs
  2207. #'ess--action-R-open-vignette)
  2208. 'follow-link t
  2209. 'vignette (file-name-sans-extension (nth 2 el2))
  2210. 'package pack
  2211. 'help-echo (concat path "/doc/" (nth 2 el2)))
  2212. (insert " ")
  2213. (insert-text-button "Rnw"
  2214. 'mouse-face 'highlight
  2215. 'action #'ess--action-open-in-emacs
  2216. 'follow-link t
  2217. 'help-echo (concat path "/doc/" (nth 3 el2)))
  2218. (insert " ")
  2219. (insert-text-button "R"
  2220. 'mouse-face 'highlight
  2221. 'action #'ess--action-open-in-emacs
  2222. 'follow-link t
  2223. 'help-echo (concat path "/doc/" (nth 4 el2)))
  2224. (insert (format "\t%s\n" (nth 0 el2)))))))
  2225. (goto-char (point-min))
  2226. (insert (propertize "\t\t**** Vignettes ****\n" 'face 'bold-italic))
  2227. (unless (eobp) (delete-char 1))
  2228. (setq buffer-read-only t))
  2229. (ess-display-help buff)))
  2230. ;; Support for listing R packages
  2231. (define-obsolete-variable-alias 'ess-rutils-buf 'ess-r-package-menu-buf "ESS 19.04")
  2232. (define-obsolete-variable-alias 'ess-rutils-mode-map 'ess-r-package-menu-mode-map "ESS 19.04")
  2233. (define-obsolete-function-alias 'ess-rutils-mode #'ess-r-package-menu-mode "ESS 19.04")
  2234. (defvar ess-rutils-map
  2235. (let ((map (define-prefix-command 'ess-rutils-map)))
  2236. (define-key map "l" #'ess-r-package-list-local-packages)
  2237. (define-key map "r" #'ess-r-package-list-available-packages)
  2238. (define-key map "u" #'ess-r-package-update-packages)
  2239. (define-key map "o" #'ess-rdired)
  2240. (define-key map "d" #'ess-change-directory)
  2241. (define-key map "H" #'ess-rutils-html-docs)
  2242. map))
  2243. (easy-menu-define ess-rutils-mode-menu inferior-ess-mode-menu
  2244. "Package management."
  2245. '("Package management"
  2246. ["List local packages" ess-r-package-list-local-packages t]
  2247. ["List available packages" ess-r-package-list-available-packages t]
  2248. ["Update packages" ess-r-package-update-packages t]))
  2249. (easy-menu-add-item inferior-ess-mode-menu nil ess-rutils-mode-menu "Utils")
  2250. (easy-menu-add-item ess-mode-menu nil ess-rutils-mode-menu "Process")
  2251. (defvar ess-r-package-menu-buf "*R packages*"
  2252. "Name of buffer to display R packages in.")
  2253. (defvar ess-r-package-menu-mode-map
  2254. (let ((map (make-sparse-keymap)))
  2255. (define-key map "l" #'ess-r-package-load)
  2256. (define-key map "i" #'ess-r-package-mark-install)
  2257. (define-key map "x" #'ess-r-package-execute-marks)
  2258. (define-key map "u" #'ess-r-package-unmark)
  2259. map)
  2260. "Keymap for `ess-rutils-mode'.")
  2261. (define-derived-mode ess-r-package-menu-mode tabulated-list-mode "R utils"
  2262. "Major mode for `ess-rutils-local-pkgs' and `ess-rutils-repos-pkgs'."
  2263. :group 'ess-R
  2264. (setq ess-dialect "R")
  2265. (setq mode-name (concat "R packages: " ess-local-process-name))
  2266. (setq tabulated-list-padding 2)
  2267. (setq tabulated-list-format
  2268. `[("Name" 10 t)
  2269. ("Description" 50 nil)
  2270. ("Version" 5 t)])
  2271. (tabulated-list-init-header))
  2272. (define-obsolete-function-alias 'ess-rutils-local-pkgs #'ess-r-package-list-local-packages "ESS 19.04")
  2273. (defun ess-r-package-list-local-packages ()
  2274. "List all packages in all libraries."
  2275. (interactive)
  2276. (ess-r-package--list-packages (concat ".ess.rutils.ops <- options(width = 10000);"
  2277. "print(installed.packages(fields=c(\"Title\"))[, c(\"Title\", \"Version\")]);"
  2278. "options(.ess.rutils.ops); rm(.ess.rutils.ops);"
  2279. "\n")))
  2280. (defun ess-r-package--list-packages (cmd)
  2281. "Use CMD to list packages."
  2282. (let ((process ess-local-process-name)
  2283. des-col-beginning des-col-end entries)
  2284. (with-current-buffer (ess-command cmd (get-buffer-create " *ess-rutils-pkgs*"))
  2285. (goto-char (point-min))
  2286. (delete-region (point) (1+ (point-at-eol)))
  2287. ;; Now we have a buffer with package name, description, and
  2288. ;; version. description and version are surrounded by quotes,
  2289. ;; description is separated by whitespace.
  2290. (re-search-forward "\\>[[:space:]]+")
  2291. (setq des-col-beginning (current-column))
  2292. (goto-char (point-at-eol))
  2293. ;; Unless someone has a quote character in their package version,
  2294. ;; two quotes back will be the end of the package description.
  2295. (dotimes (_ 2) (search-backward "\""))
  2296. (re-search-backward "[[:space:]]*")
  2297. (setq des-col-end (current-column))
  2298. (beginning-of-line)
  2299. (while (not (eobp))
  2300. (beginning-of-line)
  2301. (let* ((name (string-trim (buffer-substring
  2302. (point)
  2303. (progn (forward-char (1- des-col-beginning))
  2304. (point)))))
  2305. (description (string-trim (buffer-substring
  2306. (progn (forward-char 1)
  2307. (point))
  2308. (progn (forward-char (- des-col-end des-col-beginning))
  2309. (point)))))
  2310. (version (buffer-substring
  2311. (progn (end-of-line)
  2312. (search-backward "\"")
  2313. (search-backward "\"")
  2314. (forward-char 1)
  2315. (point))
  2316. (progn (search-forward "\"")
  2317. (backward-char 1)
  2318. (point)))))
  2319. (push
  2320. (list name
  2321. `[(,name
  2322. help-echo "mouse-2, RET: help on this package"
  2323. action ess-rutils-help-on-package)
  2324. ,description
  2325. ,version])
  2326. entries)
  2327. (forward-line)))
  2328. (pop-to-buffer ess-rutils-buf)
  2329. (setq ess-local-process-name process)
  2330. (setq tabulated-list-entries entries)
  2331. (ess-r-package-menu-mode)
  2332. (tabulated-list-print))))
  2333. (define-obsolete-function-alias 'ess-rutils-loadpkg #'ess-r-package-load "ESS 19.04")
  2334. (defun ess-r-package-load ()
  2335. "Load package from a library."
  2336. (interactive)
  2337. (ess-execute (concat "library('" (tabulated-list-get-id)
  2338. "', character.only = TRUE)")
  2339. 'buffer))
  2340. (defun ess-rutils-help-on-package (&optional _button)
  2341. "Display help on the package at point."
  2342. (interactive)
  2343. ;; FIXME: Should go to a help buffer
  2344. (ess-execute (concat "help(" (tabulated-list-get-id) ", package = '"
  2345. (tabulated-list-get-id)"')")
  2346. 'buffer))
  2347. (define-obsolete-function-alias 'ess-rutils-repos-pkgs #'ess-r-package-list-available-packages "ESS 19.04")
  2348. (defun ess-r-package-list-available-packages ()
  2349. "List available packages.
  2350. Use the repositories as listed by getOptions(\"repos\") in the
  2351. current R session."
  2352. (interactive)
  2353. (ess-r-package--list-packages (concat ".ess.rutils.ops <- options(width = 10000);"
  2354. "print(available.packages(fields=c(\"Title\"))[, c(\"Title\", \"Version\")]);"
  2355. "options(.ess.rutils.ops); rm(.ess.rutils.ops);"
  2356. "\n")))
  2357. (define-obsolete-function-alias 'ess-rutils-mark-install #'ess-r-package-mark-install "ESS 19.04")
  2358. (defun ess-r-package-mark-install ()
  2359. "Mark the current package for installing."
  2360. (interactive)
  2361. (tabulated-list-put-tag "i" t))
  2362. (define-obsolete-function-alias 'ess-rutils-unmark #'ess-r-package-unmark "ESS 19.04")
  2363. (defun ess-r-package-unmark ()
  2364. "Unmark the packages."
  2365. (interactive)
  2366. (tabulated-list-put-tag " " t))
  2367. (define-obsolete-function-alias 'ess-rutils-execute-marks #'ess-r-package-execute-marks "ESS 19.04")
  2368. (defun ess-r-package-execute-marks ()
  2369. "Perform all marked actions."
  2370. (interactive)
  2371. ;; Install
  2372. (save-excursion
  2373. (let ((cmd "install.packages(c(")
  2374. pkgs)
  2375. (goto-char (point-min))
  2376. (while (not (eobp))
  2377. (when (looking-at-p "i")
  2378. (setq pkgs (concat "\"" (tabulated-list-get-id) "\", " pkgs))
  2379. (tabulated-list-put-tag " "))
  2380. (forward-line))
  2381. (if pkgs
  2382. (progn (setq pkgs (substring pkgs 0 (- (length pkgs) 2)))
  2383. (setq cmd (concat cmd pkgs "))"))
  2384. (ess-execute cmd 'buffer))
  2385. (message "No packages marked for install")))))
  2386. (define-obsolete-function-alias 'ess-rutils-update-pkgs #'ess-r-package-update-packages "ESS 19.04")
  2387. (defun ess-r-package-update-packages (lib repo)
  2388. "Update packages in library LIB and repo REPO.
  2389. This also uses checkBuilt=TRUE to rebuild installed packages if
  2390. needed."
  2391. (interactive
  2392. (list (ess-completing-read "Library to update: " (ess-get-words-from-vector
  2393. "as.character(.libPaths())\n"))
  2394. (ess-completing-read "Repo: " (ess-get-words-from-vector
  2395. "as.character(getOption(\"repos\"))\n"))))
  2396. (ess-execute (format "update.packages(lib.loc='%s', repos='%s', ask=FALSE, checkBuilt=TRUE)" lib repo) 'buffer))
  2397. (define-obsolete-function-alias 'ess-rutils-apropos #'ess-display-help-apropos "ESS 19.04")
  2398. ;; Miscellaneous helper functions
  2399. (defun ess-rutils-rm-all ()
  2400. "Remove all R objects."
  2401. (interactive)
  2402. (when (y-or-n-p "Delete all objects? ")
  2403. (ess-execute "rm(list=ls())" 'buffer)))
  2404. (defun ess-rutils-load-wkspc (file)
  2405. "Load workspace FILE into R."
  2406. (interactive "fFile with workspace to load: ")
  2407. (ess-execute (concat "load('" file "')") 'buffer))
  2408. (defun ess-rutils-save-wkspc (file)
  2409. "Save FILE workspace as file.RData."
  2410. (interactive "FSave workspace to file (no extension): ")
  2411. (ess-execute (concat "save.image('" file ".RData')") 'buffer))
  2412. (defun ess-rutils-quit ()
  2413. "Kill the ess-rutils buffer and return to the iESS buffer."
  2414. (interactive)
  2415. (ess-switch-to-end-of-ESS)
  2416. (kill-buffer ess-rutils-buf))
  2417. (defun ess-rutils-html-docs (&optional remote)
  2418. "Use `browse-url' to navigate R html documentation.
  2419. Documentation is produced by a modified help.start(), that
  2420. returns the URL produced by GNU R's http server. If called with a
  2421. prefix, the modified help.start() is called with update=TRUE. The
  2422. optional REMOTE argument should be a string with a valid URL for
  2423. the 'R_HOME' directory on a remote server (defaults to NULL)."
  2424. (interactive)
  2425. (let* ((update (if current-prefix-arg "update=TRUE" "update=FALSE"))
  2426. (remote (if (or (and remote (not (string= "" remote))))
  2427. (concat "remote=" remote) "remote=NULL"))
  2428. (proc ess-local-process-name)
  2429. (rhtml (format ".ess_help_start(%s, %s)\n" update remote)))
  2430. (with-temp-buffer
  2431. (ess-command rhtml (current-buffer) nil nil nil (get-process proc))
  2432. (let* ((begurl (search-backward "http://"))
  2433. (endurl (search-forward "index.html"))
  2434. (url (buffer-substring-no-properties begurl endurl)))
  2435. (browse-url url)))))
  2436. (defun ess-rutils-rsitesearch (string)
  2437. "Search the R archives for STRING, and show results using `browse-url'.
  2438. If called with a prefix, options are offered (with completion)
  2439. for matches per page, sections of the archives to search,
  2440. displaying results in long or short formats, and sorting by any
  2441. given field. Options should be separated by value of
  2442. `crm-default-separator'."
  2443. (interactive "sSearch string: ")
  2444. (let ((site "https://search.r-project.org/cgi-bin/namazu.cgi?query=")
  2445. (okstring (replace-regexp-in-string " +" "+" string)))
  2446. (if current-prefix-arg
  2447. (let ((mpp (concat
  2448. "&max="
  2449. (completing-read
  2450. "Matches per page: "
  2451. '(("20" 1) ("30" 2) ("40" 3) ("50" 4) ("100" 5)))))
  2452. (format (concat
  2453. "&result="
  2454. (completing-read
  2455. "Format: " '(("normal" 1) ("short" 2))
  2456. nil t "normal" nil "normal")))
  2457. (sortby (concat
  2458. "&sort="
  2459. (completing-read
  2460. "Sort by: "
  2461. '(("score" 1) ("date:late" 2) ("date:early" 3)
  2462. ("field:subject:ascending" 4)
  2463. ("field:subject:decending" 5)
  2464. ("field:from:ascending" 6) ("field:from:decending" 7)
  2465. ("field:size:ascending" 8) ("field:size:decending" 9))
  2466. nil t "score" nil "score")))
  2467. (restrict (concat
  2468. "&idxname="
  2469. (mapconcat
  2470. 'identity
  2471. (completing-read-multiple
  2472. "Limit search to: "
  2473. '(("Rhelp02a" 1) ("functions" 2)
  2474. ("docs" 3) ("Rhelp01" 4))
  2475. nil t "Rhelp02a,functions,docs" nil
  2476. "Rhelp02a,functions,docs") "&idxname="))))
  2477. (browse-url (concat site okstring mpp format sortby restrict)))
  2478. (browse-url (concat site okstring "&max=20&result=normal&sort=score"
  2479. "&idxname=Rhelp02a&idxname=functions&idxname=docs")))))
  2480. (defun ess-rutils-help-search (string)
  2481. "Search for STRING using help.search()."
  2482. (interactive "sString to search for? ")
  2483. (let ((proc ess-local-process-name))
  2484. (pop-to-buffer "foobar")
  2485. (ess-command (concat "help.search('" string "')\n")
  2486. (current-buffer) nil nil nil (get-process proc))))
  2487. (make-obsolete 'ess-rutils-rhtml-fn "overwrite .ess_help_start instead." "ESS 18.10")
  2488. ;; Create functions that can be called for running different versions
  2489. ;; of R.
  2490. ;; FIXME: Should be set in ess-custom
  2491. (setq ess-rterm-version-paths
  2492. (ess-flatten-list
  2493. (delete-dups
  2494. (if (not ess-directory-containing-R)
  2495. (if (getenv "ProgramW6432")
  2496. (let ((P-1 (getenv "ProgramFiles(x86)"))
  2497. (P-2 (getenv "ProgramW6432")))
  2498. (nconc
  2499. ;; Always 32 on 64 bit OS, nil on 32 bit OS
  2500. (ess-find-rterm (concat P-1 "/R/") "bin/Rterm.exe")
  2501. (ess-find-rterm (concat P-1 "/R/") "bin/i386/Rterm.exe")
  2502. ;; Keep this both for symmetry and because it can happen:
  2503. (ess-find-rterm (concat P-1 "/R/") "bin/x64/Rterm.exe")
  2504. ;; Always 64 on 64 bit OS, nil on 32 bit OS
  2505. (ess-find-rterm (concat P-2 "/R/") "bin/Rterm.exe")
  2506. (ess-find-rterm (concat P-2 "/R/") "bin/i386/Rterm.exe")
  2507. (ess-find-rterm (concat P-2 "/R/") "bin/x64/Rterm.exe")))
  2508. (let ((PF (getenv "ProgramFiles")))
  2509. (nconc
  2510. ;; Always 32 on 32 bit OS, depends on 32 or 64 process on 64 bit OS
  2511. (ess-find-rterm (concat PF "/R/") "bin/Rterm.exe")
  2512. (ess-find-rterm (concat PF "/R/") "bin/i386/Rterm.exe")
  2513. (ess-find-rterm (concat PF "/R/") "bin/x64/Rterm.exe"))))
  2514. (let ((PF ess-directory-containing-R))
  2515. (nconc
  2516. (ess-find-rterm (concat PF "/R/") "bin/Rterm.exe")
  2517. (ess-find-rterm (concat PF "/R/") "bin/i386/Rterm.exe")
  2518. (ess-find-rterm (concat PF "/R/") "bin/x64/Rterm.exe")))))))
  2519. (ess-r-define-runners)
  2520. ;;*;; Provide and auto-loads
  2521. ;;;###autoload
  2522. (add-to-list 'auto-mode-alist '("/Makevars\\(\\.win\\)?$" . makefile-mode))
  2523. ;;;###autoload
  2524. (add-to-list 'auto-mode-alist '("DESCRIPTION$" . conf-colon-mode))
  2525. (provide 'ess-r-mode)
  2526. ;;; Local variables:
  2527. ;;; mode: emacs-lisp
  2528. ;;; byte-compile-warnings: (not lexical)
  2529. ;;; End:
  2530. ;;; ess-r-mode.el ends here