Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

2974 lines
127 KiB

5 years ago
  1. ;;; ess-inf.el --- Support for running S as an inferior Emacs process -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 1989-1994 Bates, Kademan, Ritter and Smith
  3. ;; Copyright (C) 1997-1999 A.J. Rossini <rossini@u.washington.edu>,
  4. ;; Martin Maechler <maechler@stat.math.ethz.ch>.
  5. ;; Copyright (C) 2000--2010 A.J. Rossini, Richard M. Heiberger, Martin
  6. ;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
  7. ;; Copyright (C) 2011--2012 A.J. Rossini, Richard M. Heiberger, Martin Maechler,
  8. ;; Kurt Hornik, Rodney Sparapani, Stephen Eglen and Vitalie Spinu.
  9. ;; Author: David Smith <dsmith@stats.adelaide.edu.au>
  10. ;; Created: 7 Jan 1994
  11. ;; Maintainer: ESS-core <ESS-core@r-project.org>
  12. ;; This file is part of ESS
  13. ;; This file is free software; you can redistribute it and/or modify
  14. ;; it under the terms of the GNU General Public License as published by
  15. ;; the Free Software Foundation; either version 2, or (at your option)
  16. ;; any later version.
  17. ;; This file is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  20. ;; GNU General Public License for more details.
  21. ;; A copy of the GNU General Public License is available at
  22. ;; https://www.r-project.org/Licenses/
  23. ;;; Commentary:
  24. ;; Code for handling running ESS processes.
  25. ;;; Code:
  26. (eval-when-compile
  27. (require 'cl-lib)
  28. (require 'tramp)
  29. (require 'subr-x))
  30. (require 'ess-utils)
  31. (require 'ess)
  32. (require 'ess-tracebug)
  33. (require 'ansi-color)
  34. (require 'comint)
  35. (require 'compile)
  36. (require 'format-spec)
  37. (require 'overlay)
  38. (require 'project)
  39. ;; Don't require tramp at run time. It's an expensive library to load.
  40. ;; Instead, guard calls with (require 'tramp) and silence the byte
  41. ;; compiler.
  42. (declare-function tramp-sh-handle-expand-file-name "tramp-sh" (name &optional dir))
  43. (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
  44. (declare-function tramp-tramp-file-p "tramp" (name))
  45. (declare-function inferior-ess-r-mode "ess-r-mode" ())
  46. (declare-function inferior-ess-julia-mode "ess-julia" ())
  47. (declare-function inferior-ess-stata-mode "ess-stata-mode" ())
  48. (declare-function extract-rectangle-bounds "rect" (start end))
  49. (declare-function ess-mode "ess-mode" ())
  50. (declare-function ess-complete-object-name "ess-r-completion" ())
  51. ;; FIXME:This one should not be necessary
  52. (declare-function ess-display-help-on-object "ess-help" (object &optional command))
  53. (declare-function ess-dump-object-into-edit-buffer "ess-mode" (object))
  54. (defvar add-log-current-defun-header-regexp)
  55. ;; The following declares can be removed once we drop Emacs 25
  56. (declare-function tramp-file-name-method "tramp")
  57. (declare-function tramp-file-name-user "tramp")
  58. (declare-function tramp-file-name-host "tramp")
  59. (declare-function tramp-file-name-localname "tramp")
  60. (declare-function tramp-file-name-hop "tramp")
  61. (defcustom inferior-ess-mode-hook nil
  62. "Hook for customizing inferior ESS mode.
  63. Called after `inferior-ess-mode' is entered and variables have
  64. been initialized."
  65. :group 'ess-hooks
  66. :type 'hook)
  67. (defvar inferior-ess-mode-syntax-table
  68. (let ((tab (copy-syntax-table comint-mode-syntax-table)))
  69. tab)
  70. "Syntax table for `inferior-ess-mode'.")
  71. (defun inferior-ess--set-major-mode (dialect)
  72. "Set major mode according to DIALECT."
  73. (cond ((string= "R" dialect)
  74. (progn (require 'ess-r-mode)
  75. (inferior-ess-r-mode)))
  76. ((string= "julia" dialect)
  77. (progn (require 'ess-julia)
  78. (inferior-ess-julia-mode)))
  79. ((string= "stata" dialect)
  80. (progn (require 'ess-stata-mode)
  81. (inferior-ess-stata-mode)))
  82. ;; FIXME: we need this horrible hack so that
  83. ;; inferior-ess-mode-syntax-table gets set for
  84. ;; languages that still rely on the old way of doing
  85. ;; things (before we used define-derived-mode for
  86. ;; inferior modes).
  87. (t
  88. (progn
  89. (setq-local inferior-ess-mode-syntax-table
  90. (eval (or (alist-get 'inferior-ess-mode-syntax-table ess-local-customize-alist)
  91. (alist-get 'ess-mode-syntax-table ess-local-customize-alist))))
  92. (inferior-ess-mode)))))
  93. ;;*;; Process handling
  94. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  95. ;;; In this section:
  96. ;;;
  97. ;;; * User commands for starting an ESS process
  98. ;;; * Functions called at startup
  99. ;;; * Process handling code
  100. ;;; * Multiple process implementation
  101. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  102. ;;*;; Starting a process
  103. (defun ess-proc-name (n name)
  104. "Return name of process N, as a string, with NAME prepended.
  105. If `ess-plain-first-buffername', then initial process is number-free."
  106. (concat name
  107. (if (not (and ess-plain-first-buffername
  108. (= n 1))) ; if not both first and plain-first add number
  109. (concat ":" (number-to-string n)))))
  110. (defvar-local inferior-ess--local-data nil
  111. "Program name and arguments used to start the inferior process.")
  112. (defun inferior-ess (start-args customize-alist &optional no-wait)
  113. "Start inferior ESS process.
  114. Without a prefix argument, starts a new ESS process, or switches
  115. to the ESS process associated with the current buffer. With
  116. START-ARGS (perhaps specified via \\[universal-argument]), starts
  117. the process with those args. The current buffer is used if it is
  118. an `inferior-ess-mode' or `ess-transcript-mode' buffer.
  119. If `ess-ask-about-transfile' is non-nil, you will be asked for a
  120. transcript file to use. If there is no transcript file, the
  121. buffer name will be like *R* or *R2*, determined by
  122. `ess-gen-proc-buffer-name-function'.
  123. Takes the program name from the variable `inferior-ess-program'.
  124. See Info node `(ess)Customizing startup' and
  125. `display-buffer-alist' to control where and how the buffer is
  126. displayed.
  127. \(Type \\[describe-mode] in the process buffer for a list of
  128. commands.)
  129. CUSTOMIZE-ALIST is the list of dialect-specific variables. When
  130. non-nil, NO-WAIT tells ESS not to wait for the process to finish.
  131. This may be useful for debugging."
  132. ;; Use the current buffer if it is in inferior-ess-mode or ess-trans-mode
  133. ;; If not, maybe ask about starting directory and/or transcript file.
  134. ;; If no transfile, use buffer *S*
  135. ;; This function is primarily used to figure out the Process and
  136. ;; buffer names to use for inferior-ess.
  137. (run-hooks 'ess-pre-run-hook)
  138. (let* ((dialect (eval (cdr (assoc 'ess-dialect customize-alist))))
  139. (process-environment process-environment)
  140. ;; Use dialect if not R, R program name otherwise
  141. (temp-dialect (if ess-use-inferior-program-in-buffer-name ;VS[23-02-2013]: FIXME: this should not be here
  142. (if (string-equal dialect "R")
  143. (file-name-nondirectory inferior-ess-r-program)
  144. dialect)
  145. dialect))
  146. (inf-buf (inferior-ess--get-proc-buffer-create temp-dialect))
  147. (proc-name (buffer-local-value 'ess-local-process-name inf-buf))
  148. (cur-dir (inferior-ess--maybe-prompt-startup-directory proc-name temp-dialect))
  149. (default-directory cur-dir))
  150. (with-current-buffer inf-buf
  151. ;; TODO: Get rid of this, we should rely on modes to set the
  152. ;; variables they need.
  153. (ess-setq-vars-local customize-alist)
  154. (inferior-ess--set-major-mode ess-dialect)
  155. ;; Set local variables after changing mode because they might
  156. ;; not be permanent
  157. (setq default-directory cur-dir)
  158. (setq inferior-ess--local-data (cons inferior-ess-program start-args))
  159. ;; Read the history file
  160. (when ess-history-file
  161. (setq comint-input-ring-file-name
  162. (expand-file-name (if (eql t ess-history-file)
  163. (concat "." ess-dialect "history")
  164. ess-history-file)
  165. ess-history-directory))
  166. (comint-read-input-ring))
  167. ;; Show the buffer
  168. ;; TODO: Remove inferior-ess-own-frame after ESS 19.04, then just have:
  169. ;; (pop-to-buffer inf-buf)
  170. (pop-to-buffer inf-buf (with-no-warnings
  171. (when inferior-ess-own-frame
  172. '(display-buffer-pop-up-frame))))
  173. (let ((proc (inferior-ess--start-process inf-buf proc-name start-args)))
  174. (ess-make-buffer-current)
  175. (goto-char (point-max))
  176. (unless no-wait
  177. (ess-write-to-dribble-buffer "(inferior-ess: waiting for process to start (before hook)\n")
  178. (ess-wait-for-process proc nil 0.01 t))
  179. (unless (and proc (eq (process-status proc) 'run))
  180. (error "Process %s failed to start" proc-name))
  181. (when ess-setwd-command
  182. (ess-set-working-directory cur-dir))
  183. (setq-local font-lock-fontify-region-function #'inferior-ess-fontify-region)
  184. (setq-local ess-sl-modtime-alist nil)
  185. (run-hooks 'ess-post-run-hook)
  186. ;; User initialization can take some time ...
  187. (unless no-wait
  188. (ess-write-to-dribble-buffer "(inferior-ess 3): waiting for process after hook")
  189. (ess-wait-for-process proc)))
  190. inf-buf)))
  191. (defun inferior-ess--get-proc-buffer-create (name)
  192. "Get a process buffer, creating a new one if needed.
  193. This always returns a process-less buffer. The variable
  194. `ess-local-process-name' is set in the buffer with the name of
  195. the next process to spawn. This name may be different from the
  196. buffer name, depending on how `ess-gen-proc-buffer-name-function'
  197. generated the latter from NAME."
  198. (let* ((proc-name (let ((ntry 1))
  199. ;; Find the next non-existent process N (*R:N*)
  200. (while (get-process (ess-proc-name ntry name))
  201. (setq ntry (1+ ntry)))
  202. (ess-proc-name ntry name)))
  203. (inf-name (funcall ess-gen-proc-buffer-name-function proc-name)))
  204. (let ((buf (cond
  205. ;; Try to use current buffer, if inferior-ess-mode but
  206. ;; no process
  207. ((and (not (comint-check-proc (current-buffer)))
  208. (derived-mode-p 'inferior-ess-mode))
  209. ;; Don't change existing buffer name in this case. It
  210. ;; is very common to restart the process in the same
  211. ;; buffer.
  212. (setq proc-name ess-local-process-name)
  213. (current-buffer))
  214. ;; Pick up a transcript file
  215. (ess-ask-about-transfile
  216. (let ((transfilename (read-file-name
  217. "Use transcript file (default none):" nil "")))
  218. (if (string= transfilename "")
  219. (get-buffer-create inf-name)
  220. (find-file-noselect (expand-file-name transfilename)))))
  221. ;; Create a new buffer or take the *R:N* buffer if
  222. ;; already exists (it should contain a dead process)
  223. (t
  224. (get-buffer-create inf-name)))))
  225. ;; We generated a new process name but there might still be a
  226. ;; live process in the buffer in corner cases because of
  227. ;; `ess-gen-proc-buffer-name-function` or if the user renames
  228. ;; inferior buffers
  229. (when (comint-check-proc buf)
  230. (error "Can't start a new session in buffer `%s` because one already exists"
  231. inf-name))
  232. (with-current-buffer buf
  233. (setq-local ess-local-process-name proc-name))
  234. buf)))
  235. (defun ess--accumulation-buffer (proc)
  236. (let ((abuf (process-get proc :accum-buffer)))
  237. (if (buffer-live-p abuf)
  238. abuf
  239. (let ((abuf (get-buffer-create (format " *%s:accum*" (process-name proc)))))
  240. (process-put proc :accum-buffer abuf)
  241. (with-current-buffer abuf
  242. (buffer-disable-undo)
  243. (setq-local inhibit-modification-hooks t))
  244. abuf))))
  245. (defvar-local inferior-ess-objects-command nil
  246. "The language/dialect specific command for listing objects.
  247. It is initialized from the corresponding inferior-<lang>-objects-command
  248. and then made buffer local."); and the *-<lang>-* ones are customized!
  249. (defvar-local ess-save-lastvalue-command nil
  250. "The command to save the last value. See S section for more details.
  251. Default depends on the ESS language/dialect and hence made buffer local")
  252. (defvar-local ess-retr-lastvalue-command nil
  253. "The command to retrieve the last value. See S section for more details.
  254. Default depends on the ESS language/dialect and hence made buffer local")
  255. (defun inferior-ess-fontify-region (beg end &optional verbose)
  256. "Fontify output by output to avoid fontification spilling over prompts."
  257. (let* ((buffer-undo-list t)
  258. (inhibit-point-motion-hooks t)
  259. (font-lock-dont-widen t)
  260. (font-lock-extend-region-functions nil)
  261. (pos1 beg)
  262. (pos2))
  263. (when (< beg end)
  264. (with-silent-modifications
  265. ;; fontify chunks from prompt to prompt
  266. (while (< pos1 end)
  267. (goto-char pos1)
  268. (comint-next-prompt 1)
  269. (setq pos2 (min (point) end))
  270. (save-restriction
  271. (narrow-to-region pos1 pos2)
  272. (font-lock-default-fontify-region pos1 pos2 verbose))
  273. (setq pos1 pos2))
  274. ;; highlight errors
  275. (setq compilation--parsed beg)
  276. `(jit-lock-bounds ,beg . ,end)))))
  277. (defun ess-gen-proc-buffer-name:simple (proc-name)
  278. "Function to generate buffer name by wrapping PROC-NAME in *proc-name*.
  279. See `ess-gen-proc-buffer-name-function'."
  280. (format "*%s*" proc-name))
  281. (defun ess-gen-proc-buffer-name:directory (proc-name)
  282. "Function to generate buffer name by wrapping PROC-NAME in *PROC-NAME:DIR-NAME*.
  283. DIR-NAME is a short directory name. See
  284. `ess-gen-proc-buffer-name-function'."
  285. (format "*%s:%s*" proc-name (file-name-nondirectory
  286. (directory-file-name default-directory))))
  287. (defun ess-gen-proc-buffer-name:abbr-long-directory (proc-name)
  288. "Function to generate buffer name in the form *PROC-NAME:ABBREVIATED-LONG-DIR-NAME*.
  289. PROC-NAME is a string representing an internal process
  290. name. ABBREVIATED-LONG-DIR-NAME is an abbreviated full directory
  291. name. Abbreviation is performed by `abbreviate-file-name'. See
  292. `ess-gen-proc-buffer-name-function'."
  293. (format "*%s:%s*" proc-name (abbreviate-file-name default-directory)))
  294. (defun ess-gen-proc-buffer-name:project-or-simple (proc-name)
  295. "Function to generate buffer name in the form *PROC-NAME:PROJECT-ROOT*.
  296. PROC-NAME is a string representing an internal process name.
  297. PROJECT-ROOT is directory name returned by `project-roots'. If no
  298. project directory has been found use
  299. `ess-gen-proc-buffer-name:simple'. See
  300. `ess-gen-proc-buffer-name-function'."
  301. (if-let ((p (project-current))
  302. (proj (car (project-roots p))))
  303. (format "*%s:%s*" proc-name (file-name-nondirectory
  304. (directory-file-name proj)))
  305. (ess-gen-proc-buffer-name:simple proc-name)))
  306. (defun ess-gen-proc-buffer-name:project-or-directory (proc-name)
  307. "Function to generate buffer name in the form *PROC-NAME:PROJECT-ROOT*.
  308. PROC-NAME is a string representing an internal process name.
  309. PROJECT-ROOT is directory name returned by `project-roots' if
  310. defined. If no project directory has been found, use
  311. `ess-gen-proc-buffer-name:directory'. See
  312. `ess-gen-proc-buffer-name-function'."
  313. (if-let ((p (project-current))
  314. (proj (car (project-roots p))))
  315. (format "*%s:%s*" proc-name (file-name-nondirectory
  316. (directory-file-name proj)))
  317. (ess-gen-proc-buffer-name:directory proc-name)))
  318. ;; This ensures that people who have this set in their init file don't
  319. ;; get errors about undefined functions after upgrading ESS:
  320. (define-obsolete-function-alias 'ess-gen-proc-buffer-name:projectile-or-simple
  321. 'ess-gen-proc-buffer-name:project-or-simple "ESS 19.04")
  322. (define-obsolete-function-alias 'ess-gen-proc-buffer-name:projectile-or-directory
  323. 'ess-gen-proc-buffer-name:project-or-directory "ESS 19.04")
  324. (defun inferior-ess-available-p (&optional proc)
  325. "Return non-nil if PROC is not busy."
  326. (when-let ((proc (or proc (and ess-local-process-name
  327. (get-process ess-local-process-name)))))
  328. (unless (process-get proc 'busy)
  329. (or (ess-debug-active-p proc) ; don't send empty lines in debugger
  330. (when-let ((last-check (process-get proc 'last-availability-check)))
  331. (time-less-p (process-get proc 'last-eval) last-check))
  332. (progn
  333. ;; Send an empty string and waiting a bit to make sure we are not busy.
  334. (process-send-string proc "\n")
  335. (inferior-ess-mark-as-busy proc)
  336. (process-put proc 'availability-check t)
  337. ;; Start with a very conservative waiting time and quickly average
  338. ;; down to the actual response.
  339. (let ((avresp (or (process-get proc 'average-response-time) 0.1))
  340. (ts (current-time)))
  341. (when (accept-process-output proc (max 0.005 (* 2.0 avresp)))
  342. (let ((avresp (/ (+ (* 2.0 avresp)
  343. (float-time (time-subtract (current-time) ts)))
  344. 3.0)))
  345. (process-put proc 'average-response-time avresp)))
  346. (process-put proc 'last-availability-check ts))
  347. (not (process-get proc 'busy)))))))
  348. (defun inferior-ess--set-status (proc string)
  349. "Internal function to set the status of process PROC.
  350. Return non-nil if the process is in a ready (not busy) state."
  351. ;; TODO: do it in one search, use starting position, use prog1
  352. (let ((ready (string-match-p (concat "\\(" inferior-ess-primary-prompt "\\)\\'") string)))
  353. (process-put proc 'busy-end? (and ready (process-get proc 'busy)))
  354. ;; When "\n" inserted from inferior-ess-available-p, delete the prompt.
  355. (when (and ready
  356. (process-get proc 'availability-check)
  357. (string-match-p (concat "^" inferior-ess-primary-prompt "\\'") string))
  358. (process-put proc 'suppress-next-output? t))
  359. (process-put proc 'availability-check nil)
  360. (when ready
  361. (process-put proc 'running-async? nil))
  362. (process-put proc 'busy (not ready))
  363. (process-put proc 'sec-prompt
  364. (when inferior-ess-secondary-prompt
  365. (string-match (concat "\\(" inferior-ess-secondary-prompt "\\)\\'") string)))
  366. ready))
  367. (defun inferior-ess-mark-as-busy (proc)
  368. (process-put proc 'busy t)
  369. (process-put proc 'sec-prompt nil))
  370. (defun inferior-ess-run-callback (proc string)
  371. ;; callback is stored in 'callbacks proc property. Callbacks is a list that
  372. ;; can contain either functions to be called with two arguments PROC and
  373. ;; STRING, or cons cells of the form (func . suppress). If SUPPRESS is non-nil
  374. ;; next process output will be suppressed.
  375. (unless (process-get proc 'busy)
  376. ;; only one callback is implemented for now
  377. (let* ((cb (car (process-get proc 'callbacks)))
  378. (listp (not (functionp cb)))
  379. (suppress (and listp (consp cb) (cdr cb)))
  380. (cb (if (and listp (consp cb))
  381. (car cb)
  382. cb)))
  383. (when cb
  384. (when ess-verbose
  385. (ess-write-to-dribble-buffer "executing callback ...\n"))
  386. (when suppress
  387. (process-put proc 'suppress-next-output? t))
  388. (process-put proc 'callbacks nil)
  389. (condition-case-unless-debug err
  390. (funcall cb proc string)
  391. (error (message "%s" (error-message-string err))))))))
  392. (defun ess--if-verbose-write-process-state (proc string &optional filter)
  393. (ess-if-verbose-write
  394. (format "\n%s:
  395. --> busy:%s busy-end:%s sec-prompt:%s interruptable:%s <--
  396. --> running-async:%s callback:%s suppress-next-output:%s <--
  397. --> dbg-active:%s is-recover:%s <--
  398. --> string:%s\n"
  399. (or filter "NORMAL-FILTER")
  400. (process-get proc 'busy)
  401. (process-get proc 'busy-end?)
  402. (process-get proc 'sec-prompt)
  403. (process-get proc 'interruptable?)
  404. (process-get proc 'running-async?)
  405. (if (process-get proc 'callbacks) "yes")
  406. (process-get proc 'suppress-next-output?)
  407. (process-get proc 'dbg-active)
  408. (process-get proc 'is-recover)
  409. (if (> (length string) 150)
  410. (format "%s .... %s" (substring string 0 50) (substring string -50))
  411. string))))
  412. (defun inferior-ess-output-filter (proc string)
  413. "Standard output filter for the inferior ESS process PROC.
  414. Ring Emacs bell if process output starts with an ASCII bell, and pass
  415. the rest to `comint-output-filter'.
  416. Taken from octave-mod.el."
  417. (inferior-ess--set-status proc string)
  418. (ess--if-verbose-write-process-state proc string)
  419. (inferior-ess-run-callback proc string)
  420. (if (process-get proc 'suppress-next-output?)
  421. ;; works only for suppressing short output, for time being is enough (for callbacks)
  422. (process-put proc 'suppress-next-output? nil)
  423. (comint-output-filter proc (inferior-ess-strip-ctrl-g string))))
  424. (defun inferior-ess-strip-ctrl-g (string)
  425. "Strip leading `^G' character.
  426. If STRING starts with a `^G', ring the Emacs bell and strip it.
  427. Depending on the value of `visible-bell', either the frame will
  428. flash or you'll hear a beep. Taken from octave-mod.el."
  429. (if (string-match "^\a" string)
  430. (progn
  431. (ding)
  432. (setq string (substring string 1))))
  433. string)
  434. (defun ess-process-sentinel (proc message)
  435. "Sentinel for use with ESS processes.
  436. This marks the process with a message, at a particular time point."
  437. (let ((abuf (process-get proc :accum-buffer)))
  438. (when (buffer-live-p abuf)
  439. (kill-buffer abuf)))
  440. (let ((pbuf (process-buffer proc)))
  441. (when (buffer-live-p pbuf)
  442. (with-current-buffer pbuf
  443. (save-excursion
  444. (setq message (substring message 0 -1)) ; strip newline
  445. (set-buffer (process-buffer proc))
  446. (comint-write-input-ring)
  447. (goto-char (point-max))
  448. (insert-before-markers
  449. (format "\nProcess %s %s at %s\n"
  450. (process-name proc) message (current-time-string))))))))
  451. ;; FIXME: This list is structured as '(("R:2") ("R")). It doesn't
  452. ;; appear the CDR are used. Can probably just be '("R:2" "R").
  453. (defvar ess-process-name-list nil
  454. "Alist of active ESS processes.")
  455. (defun inferior-ess--start-process (buf proc-name switches)
  456. "Make a comint process in buffer BUF with process PROC-NAME.
  457. SWITCHES is passed to `comint-exec'. BUF is guaranteed to be a
  458. process-less buffer because it was created with
  459. `inferior-ess--get-proc-buffer-create'."
  460. (with-current-buffer buf
  461. (if (eq (buffer-size) 0) nil
  462. (goto-char (point-max))
  463. (insert "\^L\n")))
  464. (let ((process-environment
  465. (nconc
  466. (list "STATATERM=emacs"
  467. (format "PAGER=%s" inferior-ess-pager))
  468. process-environment))
  469. (tramp-remote-process-environment
  470. (nconc ;; it contains a pager already, so append
  471. (when (boundp 'tramp-remote-process-environment)
  472. (copy-sequence tramp-remote-process-environment))
  473. (list "STATATERM=emacs"
  474. (format "PAGER=%s" inferior-ess-pager)))))
  475. (comint-exec buf
  476. proc-name
  477. inferior-ess-program
  478. nil
  479. (split-string switches)))
  480. (let ((proc (get-buffer-process buf)))
  481. ;; Set the process hooks
  482. (set-process-sentinel proc 'ess-process-sentinel)
  483. (set-process-filter proc 'inferior-ess-output-filter)
  484. (inferior-ess-mark-as-busy proc)
  485. ;; Add this process to ess-process-name-list, if needed
  486. (let ((conselt (assoc proc-name ess-process-name-list)))
  487. (unless conselt
  488. (setq ess-process-name-list
  489. (cons (cons proc-name nil) ess-process-name-list))))
  490. proc))
  491. ;;*;; Requester functions called at startup
  492. ;; FIXME EMACS 25.1:
  493. ;; Deprecate `ess-directory-function' in favor of `project-find-functions'?
  494. (defun inferior-ess--get-startup-directory ()
  495. (let ((dir (or (and ess--enable-experimental-projects
  496. (fboundp 'project-current)
  497. (cdr (project-current)))
  498. (and ess-directory-function
  499. (funcall ess-directory-function))
  500. ess-startup-directory
  501. default-directory)))
  502. (directory-file-name dir)))
  503. (defun inferior-ess--maybe-prompt-startup-directory (procname dialect)
  504. "Possibly prompt for a startup directory.
  505. When `ess-ask-for-ess-directory' is non-nil, prompt. PROCNAME is
  506. the name of the inferior process (e.g. \"R:1\"), and DIALECT is
  507. the language dialect (e.g. \"R\")."
  508. (let ((default-dir (if (fboundp 'inferior-ess-r--adjust-startup-directory)
  509. (inferior-ess-r--adjust-startup-directory
  510. (inferior-ess--get-startup-directory) dialect)
  511. (inferior-ess--get-startup-directory))))
  512. (if ess-ask-for-ess-directory
  513. (let ((prompt (format "%s starting project directory? " procname)))
  514. (ess-prompt-for-directory default-dir prompt))
  515. default-dir)))
  516. (defun ess-prompt-for-directory (default prompt)
  517. "PROMPT for a directory, using DEFAULT as the usual."
  518. (let* ((def-dir (file-name-as-directory default))
  519. (the-dir (expand-file-name
  520. (file-name-as-directory
  521. (read-directory-name prompt def-dir def-dir t nil)))))
  522. (if (file-directory-p the-dir) nil
  523. (error "%s is not a valid directory" the-dir))
  524. the-dir))
  525. ;;*;; General process handling code
  526. (defmacro with-ess-process-buffer (no-error &rest body)
  527. "Execute BODY in the process buffer of `ess-current-process-name'.
  528. If NO-ERROR is t don't trigger error when there is not current
  529. process. Symbol *proc* is bound to the current process during the
  530. evaluation of BODY."
  531. (declare (indent 1) (debug t))
  532. `(let ((*proc* (and ess-local-process-name (get-process ess-local-process-name))))
  533. (if *proc*
  534. (with-current-buffer (process-buffer *proc*)
  535. ,@body)
  536. (unless ,no-error
  537. (error "No current ESS process")))))
  538. (defmacro ess-with-current-buffer (buffer &rest body)
  539. "Like `with-current-buffer' but with transfer of some essential
  540. local ESS vars like `ess-local-process-name'."
  541. (declare (indent 1) (debug t))
  542. (let ((lpn (make-symbol "lpn"))
  543. (dialect (make-symbol "dialect"))
  544. (alist (make-symbol "alist")))
  545. `(let ((,lpn ess-local-process-name)
  546. (,dialect ess-dialect)
  547. (,alist ess-local-customize-alist))
  548. (with-current-buffer ,buffer
  549. (ess-setq-vars-local (eval ,alist))
  550. (setq ess-local-process-name ,lpn)
  551. (setq ess-dialect ,dialect)
  552. ,@body))))
  553. (dolist (mode '(emacs-lisp-mode lisp-interaction-mode))
  554. (font-lock-add-keywords
  555. mode
  556. '(("(\\(ess-with-current-buffer\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"
  557. (1 font-lock-keyword-face)
  558. (2 font-lock-variable-name-face)))))
  559. (defun ess-get-process (&optional name use-another)
  560. "Return the ESS process named by NAME.
  561. If USE-ANOTHER is non-nil, and the process NAME is not
  562. running (anymore), try to connect to another if there is one. By
  563. default (USE-ANOTHER is nil), the connection to another process
  564. happens interactively (when possible)."
  565. (setq name (or name ess-local-process-name))
  566. (cl-assert name nil "No ESS process is associated with this buffer now")
  567. (update-ess-process-name-list)
  568. (cond ((assoc name ess-process-name-list)
  569. (get-process name))
  570. ((= 0 (length ess-process-name-list))
  571. (save-current-buffer
  572. (message "trying to (re)start process %s for language %s ..."
  573. name ess-language)
  574. (ess-start-process-specific ess-language ess-dialect)
  575. ;; and return the process: "call me again"
  576. (ess-get-process name)))
  577. ;; else: there are other running processes
  578. (use-another ; connect to another running process : the first one
  579. (let ((other-name (car (elt ess-process-name-list 0))))
  580. ;; "FIXME": try to find the process name that matches *closest*
  581. (message "associating with *other* process '%s'" other-name)
  582. (ess-get-process other-name)))
  583. ((and (not noninteractive)
  584. (y-or-n-p
  585. (format "Process %s is not running, but others are. Switch? " name)))
  586. (ess-force-buffer-current (concat ess-dialect " process to use: ") 'force)
  587. (ess-get-process ess-current-process-name))
  588. (t (error "Process %s is not running" name))))
  589. (defun inferior-ess-default-directory ()
  590. (ess-get-process-variable 'default-directory))
  591. ;;--- Unfinished idea (ESS-help / R-help ) -- probably not worth it...
  592. ;;- (defun ess-set-inferior-program (filename)
  593. ;;- "Allows to set or change `inferior-ess-program', the program (file)name."
  594. ;;- (interactive "fR executable (script) file: ")
  595. ;;- ;; "f" : existing file {file name completion} !
  596. ;;- (setq inferior-ess-program filename))
  597. ;; the inferior-ess-program is initialized in the customize..alist,
  598. ;; e.g. from inferior-ess-r-program ... --> should change rather these.
  599. ;; However these really depend on the current ess-language!
  600. ;; Plan: 1) must know and use ess-language
  601. ;; 2) change the appropriate inferior-<ESSlang>-program
  602. ;; (how?) in R/S : assign(paste("inferior-",ESSlang,"-p...."), filename))
  603. ;;*;; Multiple process handling code
  604. ;; FIXME: It seems the only effect of this function is to remove dead
  605. ;; processes from `ess-process-name-list'. Am I missing something?
  606. (defun ess-make-buffer-current nil
  607. "Make the process associated with the current buffer the current ESS process.
  608. Returns the name of the process, or nil if the current buffer has none."
  609. (update-ess-process-name-list)
  610. ;; (if ess-local-process-name
  611. ;; (setq ess-current-process-name ess-local-process-name))
  612. ess-local-process-name)
  613. (defun ess-get-process-variable (var)
  614. "Return the variable VAR (symbol) local to ESS process called NAME (string)."
  615. (buffer-local-value var (process-buffer (ess-get-process ess-local-process-name))))
  616. (defun ess-set-process-variable (var val)
  617. "Set variable VAR (symbol) local to ESS process called NAME (string) to VAL."
  618. (with-current-buffer (process-buffer (ess-get-process ess-local-process-name))
  619. (set var val)))
  620. (defun ess-process-live-p (&optional proc)
  621. "Check if the local ess process is alive.
  622. Return nil if current buffer has no associated process, or
  623. process was killed. PROC defaults to `ess-local-process-name'"
  624. (and (or proc ess-local-process-name)
  625. (let ((proc (or proc (get-process ess-local-process-name))))
  626. (and (processp proc)
  627. (process-live-p proc)))))
  628. (defun ess-process-get (propname &optional proc)
  629. "Return the variable PROPNAME (symbol) from the plist of the current ESS process.
  630. PROC defaults to process with name `ess-local-process-name'."
  631. (process-get (or proc (get-process ess-local-process-name)) propname))
  632. (defun ess-process-put (propname value &optional proc)
  633. "Set the variable PROPNAME (symbol) to VALUE in the plist of the current ESS process.
  634. PROC defaults to the process given by `ess-local-process-name'"
  635. (process-put (or proc (get-process ess-local-process-name)) propname value))
  636. (defun ess-start-process-specific (language dialect)
  637. "Start an ESS process.
  638. Typically from a language-specific buffer, using LANGUAGE (and DIALECT)."
  639. (save-current-buffer
  640. (let ((dsymb (intern dialect)))
  641. (ess-write-to-dribble-buffer
  642. (format " ..start-process-specific: lang:dialect= %s:%s, current-buf=%s\n"
  643. language dialect (current-buffer)))
  644. (cond ;; ((string= dialect "R") (R))
  645. ;; ((string= language "S") ;
  646. ;; (message "ESS process not running, trying to start R, since language = 'S")
  647. ;; (R))
  648. ;; ((string= dialect STA-dialect-name) (stata))
  649. ;;general case
  650. ((fboundp dsymb)
  651. (funcall dsymb))
  652. (t ;; else: ess-dialect is not a function
  653. ;; Typically triggered from
  654. ;; ess-force-buffer-current("Process to load into: ")
  655. ;; \--> ess-request-a-process("Process to load into: " no-switch)
  656. (error "No ESS processes running; not yet implemented to start (%s,%s)"
  657. language dialect))))))
  658. (defun ess-request-a-process (message &optional noswitch ask-if-1)
  659. "Ask for a process, and make it the current ESS process.
  660. If there is exactly one process, only ask if ASK-IF-1 is non-nil.
  661. Also switches to the process buffer unless NOSWITCH is non-nil. Interactively,
  662. NOSWITCH can be set by giving a prefix argument.
  663. Returns the name of the selected process."
  664. (interactive
  665. (list "Switch to which ESS process? " current-prefix-arg))
  666. ; prefix sets 'noswitch
  667. (ess-write-to-dribble-buffer "ess-request-a-process: {beginning}\n")
  668. (update-ess-process-name-list)
  669. (setq ess-dialect (or ess-dialect
  670. (ess-completing-read
  671. "Set `ess-dialect'"
  672. (delete-dups (list "R" "S+" (or (bound-and-true-p S+-dialect-name) "S+")
  673. "stata" (or (bound-and-true-p STA-dialect-name) "stata")
  674. "julia" "SAS" "XLS" "ViSta")))))
  675. (let* ((pname-list (delq nil ;; keep only those matching dialect
  676. (append
  677. (mapcar (lambda (lproc)
  678. (and (equal ess-dialect
  679. (buffer-local-value
  680. 'ess-dialect
  681. (process-buffer (get-process (car lproc)))))
  682. (not (equal ess-local-process-name (car lproc)))
  683. (car lproc)))
  684. ess-process-name-list)
  685. ;; append local only if running
  686. (when (assoc ess-local-process-name ess-process-name-list)
  687. (list ess-local-process-name)))))
  688. (num-processes (length pname-list))
  689. (auto-started?))
  690. (if (or (= 0 num-processes)
  691. (and (= 1 num-processes)
  692. (not (equal ess-dialect ;; don't auto connect if from different dialect
  693. (buffer-local-value
  694. 'ess-dialect
  695. (process-buffer (get-process
  696. (car pname-list))))))))
  697. ;; try to start "the appropriate" process
  698. (progn
  699. (ess-write-to-dribble-buffer
  700. (concat " ... request-a-process:\n "
  701. (format
  702. "major mode %s; current buff: %s; ess-language: %s, ess-dialect: %s\n"
  703. major-mode (current-buffer) ess-language ess-dialect)))
  704. (ess-start-process-specific ess-language ess-dialect)
  705. (ess-write-to-dribble-buffer
  706. (format " ... request-a-process: buf=%s\n" (current-buffer)))
  707. (setq num-processes 1
  708. pname-list (car ess-process-name-list)
  709. auto-started? t)))
  710. ;; now num-processes >= 1 :
  711. (let* ((proc-buffers (mapcar (lambda (lproc)
  712. (buffer-name (process-buffer (get-process lproc))))
  713. pname-list))
  714. (proc
  715. (if (or auto-started?
  716. (and (not ask-if-1) (= 1 num-processes)))
  717. (progn
  718. (message "using process '%s'" (car proc-buffers))
  719. (car pname-list))
  720. ;; else
  721. (unless (and ess-current-process-name
  722. (get-process ess-current-process-name))
  723. (setq ess-current-process-name nil))
  724. (when message
  725. (setq message (replace-regexp-in-string ": +\\'" "" message))) ;; <- why is this here??
  726. ;; ask for buffer name not the *real* process name:
  727. (let ((buf (ess-completing-read message (append proc-buffers (list "*new*")) nil t nil nil)))
  728. (if (equal buf "*new*")
  729. (progn
  730. (ess-start-process-specific ess-language ess-dialect) ;; switches to proc-buff
  731. (caar ess-process-name-list))
  732. (process-name (get-buffer-process buf))
  733. ))
  734. )))
  735. (if noswitch
  736. (pop-to-buffer (current-buffer)) ;; VS: this is weird, but is necessary
  737. (pop-to-buffer (buffer-name (process-buffer (get-process proc)))))
  738. proc)))
  739. (defun ess-force-buffer-current (&optional prompt force no-autostart ask-if-1)
  740. "Make sure the current buffer is attached to an ESS process.
  741. If not, or FORCE (prefix argument) is non-nil, prompt for a
  742. process name with PROMPT. If NO-AUTOSTART is nil starts the new
  743. process if process associated with current buffer has
  744. died. `ess-local-process-name' is set to the name of the process
  745. selected. `ess-dialect' is set to the dialect associated with
  746. the process selected. ASK-IF-1 asks user for the process, even if
  747. there is only one process running. Returns the inferior buffer if
  748. it was successfully forced, throws an error otherwise."
  749. (interactive
  750. (list (concat ess-dialect " process to use: ") current-prefix-arg nil))
  751. (let ((proc-name (ess-make-buffer-current)))
  752. (cond ((and (not force) proc-name (get-process proc-name)))
  753. ;; Make sure the source buffer is attached to a process
  754. ((and ess-local-process-name (not force) no-autostart)
  755. (error "Process %s has died" ess-local-process-name))
  756. ;; Request a process if `ess-local-process-name' is nil
  757. (t
  758. (let* ((prompt (or prompt "Process to use: "))
  759. (proc (ess-request-a-process prompt 'no-switch ask-if-1)))
  760. (setq ess-local-process-name proc)))))
  761. (process-buffer (get-process ess-local-process-name)))
  762. (defalias 'inferior-ess-force #'ess-force-buffer-current)
  763. (defun ess-switch-process ()
  764. "Force a switch to a new underlying process."
  765. (interactive)
  766. (ess-force-buffer-current "Process to use: " 'force nil 'ask-if-1))
  767. (defun ess-get-next-available-process (&optional dialect ignore-busy)
  768. "Return first available (aka not busy) process of dialect DIALECT.
  769. DIALECT defaults to the local value of ess-dialect. Return nil if
  770. no such process has been found."
  771. (setq dialect (or dialect ess-dialect))
  772. (when dialect
  773. (let (proc)
  774. (catch 'found
  775. (dolist (p (cons ess-local-process-name
  776. (mapcar 'car ess-process-name-list)))
  777. (when p
  778. (setq proc (get-process p))
  779. (when (and proc
  780. (process-live-p proc)
  781. (equal dialect
  782. (buffer-local-value 'ess-dialect (process-buffer proc)))
  783. (or ignore-busy
  784. (inferior-ess-available-p proc)))
  785. (throw 'found proc))))))))
  786. ;;*;;; Commands for switching to the process buffer
  787. (defun ess-switch-to-ESS (eob-p)
  788. "Switch to the current inferior ESS process buffer.
  789. With (prefix) EOB-P non-nil, positions cursor at end of buffer."
  790. (interactive "P")
  791. (ess-force-buffer-current)
  792. (pop-to-buffer (buffer-name (process-buffer (get-process ess-current-process-name)))
  793. '(nil . ((inhibit-same-window . t))))
  794. (when eob-p (goto-char (point-max))))
  795. (defun ess-switch-to-end-of-ESS ()
  796. "Switch to the end of the inferior ESS process buffer."
  797. (interactive)
  798. (ess-switch-to-ESS t))
  799. (defun ess-switch-to-inferior-or-script-buffer (toggle-eob)
  800. "Switch between script and process buffer.
  801. This is a single-key command. Assuming that it is bound to C-c
  802. C-z, you can navigate back and forth between iESS and script
  803. buffer with C-c C-z C-z C-z ... If variable
  804. `ess-switch-to-end-of-proc-buffer' is t (the default) this
  805. function switches to the end of process buffer. If TOGGLE-EOB is
  806. given, the value of `ess-switch-to-end-of-proc-buffer' is
  807. toggled."
  808. (interactive "P")
  809. (let ((eob (if toggle-eob
  810. (not ess-switch-to-end-of-proc-buffer)
  811. ess-switch-to-end-of-proc-buffer)))
  812. (if (derived-mode-p 'inferior-ess-mode)
  813. (let ((dialect ess-dialect)
  814. (proc-name ess-local-process-name)
  815. (blist (buffer-list)))
  816. (while (and (pop blist)
  817. (with-current-buffer (car blist)
  818. (not (or (and (ess-derived-mode-p)
  819. (equal dialect ess-dialect)
  820. (null ess-local-process-name))
  821. (and (ess-derived-mode-p)
  822. (equal proc-name ess-local-process-name)))))))
  823. (if blist
  824. (pop-to-buffer (car blist))
  825. (message "Found no buffers for `ess-dialect' %s associated with process %s"
  826. dialect proc-name)))
  827. (ess-switch-to-ESS eob))
  828. (set-transient-map (let ((map (make-sparse-keymap))
  829. (key (vector last-command-event)))
  830. (define-key map key #'ess-switch-to-inferior-or-script-buffer) map))))
  831. (defun ess-get-process-buffer (&optional name)
  832. "Return the buffer associated with the ESS process named by NAME."
  833. (process-buffer (ess-get-process (or name ess-local-process-name))))
  834. (defun update-ess-process-name-list ()
  835. "Remove names with no process."
  836. (let (defunct)
  837. (dolist (conselt ess-process-name-list)
  838. (let ((proc (get-process (car conselt))))
  839. (unless (and proc (eq (process-status proc) 'run))
  840. (push conselt defunct))))
  841. (dolist (pointer defunct)
  842. (setq ess-process-name-list (delq pointer ess-process-name-list))))
  843. (if (eq (length ess-process-name-list) 0)
  844. (setq ess-current-process-name nil)))
  845. ;;; Functions for evaluating code
  846. ;;*;; Utils for evaluation
  847. (defun ess-build-eval-command (string &optional visibly output file &rest args)
  848. "Format an evaluation command.
  849. Wrap STRING with `ess-quote-special-chars' and dispatch on
  850. `ess-build-eval-command--override'."
  851. (setq string (ess-quote-special-chars string))
  852. (ess-build-eval-command--override string visibly output file args))
  853. (cl-defgeneric ess-build-eval-command--override
  854. (string &optional _visibly _output file &rest _args)
  855. "Default method to build eval command."
  856. (and ess-eval-command
  857. (format-spec ess-eval-command
  858. `((?s . ,string)
  859. (?f . ,file)))))
  860. (cl-defgeneric ess-build-load-command (file &optional _visibly _output &rest _args)
  861. "Format a loading command.
  862. Dispatches on the dialect-specific `ess-build-load-command'
  863. and `ess-load-command', in that order."
  864. (and ess-load-command
  865. (format ess-load-command file)))
  866. (defun ess-wait-for-process (&optional proc sec-prompt wait force-redisplay timeout)
  867. "Wait for 'busy property of the process to become nil.
  868. If SEC-PROMPT is non-nil return if secondary prompt is detected
  869. regardless of whether primary prompt was detected or not. If WAIT
  870. is non-nil wait for WAIT seconds for process output before the
  871. prompt check, default 0.002s. When FORCE-REDISPLAY is non-nil
  872. force redisplay. You better use WAIT >= 0.1 if you need
  873. FORCE-REDISPLAY to avoid excessive redisplay. If TIMEOUT is
  874. non-nil stop waiting for output after TIMEOUT seconds."
  875. (setq proc (or proc (get-process ess-local-process-name)))
  876. (setq wait (or wait 0.005))
  877. (setq timeout (or timeout most-positive-fixnum))
  878. (let ((start-time (float-time))
  879. (elapsed 0))
  880. (save-excursion
  881. (while (and
  882. (or (eq (process-status proc) 'run)
  883. (progn
  884. (when (process-buffer proc)
  885. (display-buffer (process-buffer proc)))
  886. (error "ESS process has died unexpectedly")))
  887. (< elapsed timeout)
  888. (or (accept-process-output proc wait)
  889. (unless (and sec-prompt (process-get proc 'sec-prompt))
  890. (process-get proc 'busy))))
  891. (when force-redisplay
  892. (redisplay 'force))
  893. (setq elapsed (- (float-time) start-time))
  894. (when (> elapsed .3)
  895. (setq wait .3))))))
  896. (defun inferior-ess-ordinary-filter (proc string)
  897. (inferior-ess--set-status proc string)
  898. (ess--if-verbose-write-process-state proc string "ordinary-filter")
  899. (inferior-ess-run-callback proc string)
  900. (with-current-buffer (process-buffer proc)
  901. (insert string)))
  902. (defvar ess-presend-filter-functions nil
  903. "List of functions to call before sending the input string to the process.
  904. Each function gets one argument, a string containing the text to
  905. be send to the subprocess. It should return the string sent,
  906. perhaps the same string that was received, or perhaps a modified
  907. or transformed string.
  908. The functions on the list are called sequentially, and each one
  909. is given the string returned by the previous one. The string
  910. returned by the last function is the text that is actually sent
  911. to the process. You can use `add-hook' to add functions to this
  912. list either globally or locally. The hook is executed in current
  913. buffer. Before execution, the local value of this hook in the
  914. process buffer is appended to the hook from the current buffer.")
  915. (defvar ess--inhibit-presend-hooks nil
  916. "If non-nil don't run presend hooks.")
  917. (defun ess--run-presend-hooks (process string)
  918. ;; run ess-presend-filter-functions and comint-input-filter-functions
  919. (if ess--inhibit-presend-hooks
  920. string
  921. ;;return modified string
  922. (let* ((pbuf (process-buffer process))
  923. ;; also run proc buffer local hooks
  924. (functions (unless (eq pbuf (current-buffer))
  925. (buffer-local-value 'ess-presend-filter-functions pbuf))))
  926. (setq functions (append (delq t (copy-sequence functions)) ;; even in let, delq distructs
  927. ess-presend-filter-functions))
  928. (while (and functions string)
  929. ;; cannot use run-hook-with-args here because string must be passed from one
  930. ;; function to another
  931. (if (eq (car functions) t)
  932. (let ((functions
  933. (default-value 'ess-presend-filter-functions)))
  934. (while (and functions string)
  935. (setq string (funcall (car functions) string))
  936. (setq functions (cdr functions))))
  937. (setq string (funcall (car functions) string)))
  938. (setq functions (cdr functions)))
  939. (with-current-buffer pbuf
  940. (run-hook-with-args 'comint-input-filter-functions string))
  941. string)))
  942. (defun ess--concat-new-line-maybe (string)
  943. "Append \\n at the end of STRING if missing."
  944. (if (string-match "\n\\'" string (max (- (length string) 2) 0))
  945. string
  946. (concat string "\n")))
  947. (defvar ess--dbg-del-empty-p t
  948. "Internal variable to control removal of empty lines during the debugging.
  949. Let-bind it to nil before calling `ess-send-string' or
  950. `ess-send-region' if no removal is necessary.")
  951. (defun inferior-ess--interrupt-subjob-maybe (proc)
  952. "Internal. Interrupt the process if interruptable? process variable is non-nil.
  953. Hide all the junk output in temporary buffer."
  954. (when (process-get proc 'interruptable?)
  955. (let ((cb (cadr (process-get proc 'callbacks)))
  956. (buf (get-buffer-create " *ess-temp-buff*"))
  957. (old-filter (process-filter proc))
  958. (old-buff (process-buffer proc)))
  959. (unwind-protect
  960. (progn
  961. (ess-if-verbose-write "interrupting subjob ... start")
  962. (process-put proc 'interruptable? nil)
  963. (process-put proc 'callbacks nil)
  964. (process-put proc 'running-async? nil)
  965. ;; this is to avoid putting junk in user's buffer on process
  966. ;; interruption
  967. (set-process-buffer proc buf)
  968. (set-process-filter proc 'inferior-ess-ordinary-filter)
  969. (interrupt-process proc)
  970. (when cb
  971. (ess-if-verbose-write "executing interruption callback ... ")
  972. (funcall cb proc))
  973. ;; should be very fast as it inputs only the prompt
  974. (ess-wait-for-process proc)
  975. (ess-if-verbose-write "interrupting subjob ... finished")
  976. )
  977. (set-process-buffer proc old-buff)
  978. (set-process-filter proc old-filter)))))
  979. ;;*;; Evaluation primitives
  980. (defun ess-send-string (process string &optional visibly message _type)
  981. "ESS wrapper for `process-send-string'.
  982. Run `comint-input-filter-functions' and current buffer's and
  983. PROCESS' `ess-presend-filter-functions' hooks on the input
  984. STRING. VISIBLY can be nil, t, 'nowait or a string. If string
  985. the behavior is as with 'nowait with the differences that
  986. inserted string is VISIBLY instead of STRING (evaluated command
  987. is still STRING). In all other cases the behavior is as
  988. described in `ess-eval-visibly'. STRING need not end with
  989. \\n. TYPE is a symbol indicating type of the string.
  990. MESSAGE is a message to display."
  991. ;; No support of `visibly' when there's no secondary prompt
  992. (let ((visibly (if (and (eq visibly t)
  993. (null inferior-ess-secondary-prompt))
  994. 'nowait
  995. visibly))
  996. (string (ess--run-presend-hooks process string)))
  997. (inferior-ess--interrupt-subjob-maybe process)
  998. (inferior-ess-mark-as-busy process)
  999. (process-put process 'last-eval (current-time))
  1000. (cond
  1001. ;; Wait after each line
  1002. ((eq visibly t)
  1003. (let ((ess--inhibit-presend-hooks t))
  1004. (ess-eval-linewise string)))
  1005. ;; Insert command and eval invisibly
  1006. ((or (stringp visibly)
  1007. (eq visibly 'nowait))
  1008. (with-current-buffer (process-buffer process)
  1009. (save-excursion
  1010. (goto-char (process-mark process))
  1011. (insert-before-markers
  1012. (propertize (format "%s\n"
  1013. (replace-regexp-in-string
  1014. "\n" "\n+ "
  1015. (if (stringp visibly) visibly string)))
  1016. 'font-lock-face 'comint-highlight-input)))
  1017. (process-send-string process (ess--concat-new-line-maybe string))))
  1018. (t
  1019. (process-send-string process (ess--concat-new-line-maybe string))))
  1020. (when message
  1021. (message "%s" message))))
  1022. (defun ess-send-region (process start end &optional visibly message type)
  1023. "Low level ESS version of `process-send-region'.
  1024. If VISIBLY call `ess-eval-linewise', else call
  1025. `ess-send-string'. If MESSAGE is supplied, display it at the
  1026. end. Run current buffer's and PROCESS'
  1027. `ess-presend-filter-functions' hooks. TYPE is a symbol indicating
  1028. type of the region."
  1029. (cond
  1030. ((ess-tracebug-p)
  1031. (ess-tracebug-send-region process start end visibly message type))
  1032. (t (ess-send-region--override process start end visibly message type))))
  1033. (cl-defgeneric ess-send-region--override (process start end visibly message type)
  1034. (ess-send-string process (buffer-substring start end) visibly message type))
  1035. ;;*;; Evaluation commands
  1036. (defun ess-load-file--normalise-file (file)
  1037. "Handle Tramp and system peculiarities."
  1038. (require 'tramp)
  1039. (let* ((file (if (tramp-tramp-file-p file)
  1040. (tramp-file-name-localname (tramp-dissect-file-name file))
  1041. file))
  1042. (file (if ess-microsoft-p
  1043. (ess-replace-in-string file "[\\]" "/")
  1044. file)))
  1045. (abbreviate-file-name file)))
  1046. (defun ess-load-file--normalise-buffer (file)
  1047. (when (ess-save-file file)
  1048. (error "Buffer %s has not been saved" (buffer-name file)))
  1049. (let ((source-buffer (get-file-buffer file)))
  1050. (if source-buffer
  1051. (with-current-buffer source-buffer
  1052. (when (buffer-modified-p) (save-buffer))
  1053. (ess-force-buffer-current "Process to load into: ")
  1054. (ess-check-modifications))
  1055. (ess-force-buffer-current "Process to load into: "))))
  1056. ;;;###autoload
  1057. (defun ess-load-file (&optional filename)
  1058. "Load FILENAME into an inferior ESS process.
  1059. This handles Tramp when working on a remote."
  1060. (interactive (list (or (and (ess-derived-mode-p)
  1061. (buffer-file-name))
  1062. (expand-file-name
  1063. (read-file-name "Load source file: " nil nil t)))))
  1064. (ess-load-file--normalise-buffer filename)
  1065. (setq filename (ess-load-file--normalise-file filename))
  1066. (ess-load-file--override filename)
  1067. (message "Loaded %s" filename))
  1068. (cl-defgeneric ess-load-file--override (filename)
  1069. (let ((command (ess-build-load-command filename nil t)))
  1070. (ess-send-string (ess-get-process) command t)))
  1071. ;; ;;; VS[03-09-2012]: Test Cases:
  1072. ;; (ess-command "a<-0\n" nil nil nil nil (get-process "R"))
  1073. ;; (ess-async-command-delayed "Sys.sleep(5);a<-a+1;cat(1:10)\n" nil
  1074. ;; (get-process "R") (lambda (proc) (message "done")))
  1075. ;; (ess-async-command-delayed "Sys.sleep(5)\n" nil (get-process "R")
  1076. ;; (lambda (proc) (message "done")))
  1077. ;; (process-get (get-process "R") 'running-async?)
  1078. (defun ess-command--get-proc (proc no-prompt-check)
  1079. (if proc
  1080. (unless ess-local-process-name
  1081. (setq ess-local-process-name (process-name proc)))
  1082. (setq proc (ess-get-process ess-local-process-name)))
  1083. (unless no-prompt-check
  1084. (when (process-get proc 'busy)
  1085. (user-error "ESS process not ready. Finish your command before trying again")))
  1086. proc)
  1087. (defun ess-command (cmd &optional out-buffer _sleep no-prompt-check wait proc force-redisplay)
  1088. "Send the ESS process CMD and delete the output from the ESS process buffer.
  1089. If an optional second argument OUT-BUFFER exists save the output
  1090. in that buffer. OUT-BUFFER is erased before use. CMD should have
  1091. a terminating newline. Guarantees that the value of `.Last.value'
  1092. will be preserved.
  1093. SLEEP is deprecated and no longer has any effect. WAIT and
  1094. FORCE-REDISPLAY are as in `ess-wait-for-process' and are passed
  1095. to `ess-wait-for-process'.
  1096. PROC should be a process, if nil the process name is taken from
  1097. `ess-local-process-name'. This command doesn't set 'last-eval
  1098. process variable.
  1099. Note: for critical, or error prone code you should consider
  1100. wrapping the code into:
  1101. local({
  1102. olderr <- options(error=NULL)
  1103. on.exit(options(olderr))
  1104. ...
  1105. })"
  1106. (let ((out-buffer (or out-buffer (get-buffer-create " *ess-command-output*")))
  1107. (proc (ess-command--get-proc proc no-prompt-check))
  1108. ;; Set `inhibit-quit' to t to avoid dumping R output to the
  1109. ;; process buffer if `ess-command' gets interrupted for some
  1110. ;; reason. See bugs #794 and #842
  1111. (inhibit-quit t))
  1112. (with-current-buffer (process-buffer proc)
  1113. (let ((primary-prompt inferior-ess-primary-prompt)
  1114. (oldpb (process-buffer proc))
  1115. (oldpf (process-filter proc))
  1116. (oldpm (marker-position (process-mark proc))))
  1117. (ess-if-verbose-write (format "(ess-command %s ..)" cmd))
  1118. ;; Swap the process buffer with the output buffer before
  1119. ;; sending the command
  1120. (unwind-protect
  1121. (progn
  1122. (set-process-buffer proc out-buffer)
  1123. (set-process-filter proc 'inferior-ess-ordinary-filter)
  1124. (with-current-buffer out-buffer
  1125. (setq inferior-ess-primary-prompt primary-prompt)
  1126. (setq buffer-read-only nil)
  1127. (erase-buffer)
  1128. (set-marker (process-mark proc) (point-min))
  1129. (inferior-ess-mark-as-busy proc)
  1130. (process-send-string proc cmd)
  1131. ;; Need time for ess-create-object-name-db on PC
  1132. (if no-prompt-check
  1133. (sleep-for 0.02) ; 0.1 is noticeable!
  1134. (ess-wait-for-process proc nil wait force-redisplay)
  1135. ;; Should (almost) never be incomplete unless the message
  1136. ;; contains "> " and was accidentally split by the process
  1137. ;; right there.
  1138. (while (eq :incomplete (ess-mpi-handle-messages (current-buffer)))
  1139. (ess-wait-for-process proc nil wait force-redisplay))
  1140. ;; Remove prompt
  1141. ;; If output is cat(..)ed this deletes the output
  1142. (goto-char (point-max))
  1143. (delete-region (point-at-bol) (point-max)))
  1144. (ess-if-verbose-write " .. ok{ess-command}")))
  1145. (ess-if-verbose-write " .. exiting{ess-command}\n")
  1146. ;; Restore the process buffer in its previous state
  1147. (set-process-buffer proc oldpb)
  1148. (set-process-filter proc oldpf)
  1149. (set-marker (process-mark proc) oldpm))))
  1150. out-buffer))
  1151. (defun ess-boolean-command (com &optional buf wait)
  1152. "Like `ess-command' but expects COM to print TRUE or FALSE.
  1153. If TRUE (or true) is found return non-nil otherwise nil.
  1154. Example (ess-boolean-command \"2>1\n\")"
  1155. (with-current-buffer (ess-command com buf nil nil wait)
  1156. (goto-char (point-min))
  1157. (let ((case-fold-search t))
  1158. (re-search-forward "true" nil t))))
  1159. (defun ess-string-command (com &optional buf wait)
  1160. "Returns the output of COM as a string."
  1161. (let ((prompt inferior-ess-prompt))
  1162. (with-current-buffer (ess-command com buf nil nil wait)
  1163. (goto-char (point-min))
  1164. ;; remove leading prompt
  1165. (when (and prompt (re-search-forward (concat "^" prompt) (point-at-eol) t))
  1166. (delete-region (point-min) (match-end 0)))
  1167. (ess-kill-last-line)
  1168. (buffer-substring (point-min) (point-max)))))
  1169. (defun ess-async-command (com &optional buf proc callback interrupt-callback)
  1170. "Asynchronous version of `ess-command'.
  1171. COM, BUF, WAIT and PROC are as in `ess-command'.
  1172. CALLBACK is a function of two arguments (PROC STRING) to run
  1173. after the successful execution. When INTERRUPT-CALLBACK is
  1174. non-nil, user evaluation can interrupt the
  1175. job. INTERRUPT-CALLBACK should be either t or a function of one
  1176. argument (PROC) to be called on interruption.
  1177. NOTE: Currently this function should be used only for background
  1178. jobs like caching. ESS tries to suppress any output from the
  1179. asynchronous command, but long output of COM will most likely end
  1180. up in user's main buffer."
  1181. (setq proc (or proc (get-process ess-local-process-name)))
  1182. (cond ((not (and proc (eq (process-status proc) 'run)))
  1183. (error "Process %s is dead" proc))
  1184. ((process-get proc 'busy)
  1185. (error "Process %s is busy" proc))
  1186. ((process-get proc 'running-async?)
  1187. (error "Process %s is already running an async command" proc)))
  1188. (when (eq interrupt-callback t)
  1189. (setq interrupt-callback (lambda (_proc))))
  1190. (process-put proc 'callbacks (list (cons callback 'suppress-output)
  1191. interrupt-callback))
  1192. (process-put proc 'interruptable? (and interrupt-callback t))
  1193. (process-put proc 'running-async? t)
  1194. (ess-command com buf nil 'no-prompt-check .01 proc))
  1195. (defun ess-async-command-delayed (com buf proc &optional callback delay)
  1196. "Delayed asynchronous ess-command.
  1197. COM and BUF are as in `ess-command'. DELAY is a number of idle
  1198. seconds to wait before starting the execution of the COM. On
  1199. interruption (by user's evaluation) ESS tries to rerun the job
  1200. after next DELAY seconds, and the whole process repeats itself
  1201. until the command manages to run completely. DELAY defaults to
  1202. `ess-idle-timer-interval' + 3 seconds. You should always provide
  1203. PROC for delayed evaluation, as the current process might change,
  1204. leading to unpredictable consequences. This function is a wrapper
  1205. of `ess-async-command' with an explicit interrupt-callback."
  1206. (let* ((delay (or delay
  1207. (+ ess-idle-timer-interval 3)))
  1208. (int-cb `(lambda (proc)
  1209. (ess-async-command-delayed ,com ,buf proc ,callback ,delay)))
  1210. (com-fun `(lambda ()
  1211. (when (eq (process-status ,proc) 'run) ; do nothing if not running
  1212. (if (or (process-get ,proc 'busy) ; if busy, try later
  1213. (process-get ,proc 'running-async?))
  1214. ;; idle timer doesn't work here
  1215. (run-with-timer ,delay nil 'ess-async-command-delayed
  1216. ,com ,buf ,proc ,callback ,delay))
  1217. (ess-async-command ,com ,buf ,proc ,callback ',int-cb)))))
  1218. (run-with-idle-timer delay nil com-fun)))
  1219. (defun ess-load-library ()
  1220. "Prompt and load dialect specific library/package/module.
  1221. Note that in R these are called 'packages' and the name of this
  1222. function has nothing to do with R package mechanism, but it
  1223. rather serves a generic, dialect independent purpose. It is also
  1224. similar to `load-library' Emacs function."
  1225. (interactive)
  1226. (let ((ess-eval-visibly-p t)
  1227. (packs (ess-installed-packages))
  1228. pack)
  1229. (setq pack (ess-completing-read "Load" packs))
  1230. (ess-load-library--override pack)
  1231. (ess--mark-search-list-as-changed)))
  1232. (cl-defgeneric ess-installed-packages ()
  1233. "Return a list of installed packages.")
  1234. (cl-defgeneric ess-load-library--override (pack)
  1235. "Load library/package PACK.")
  1236. ;;*;; Evaluating lines, paragraphs, regions, and buffers.
  1237. (defun ess-eval-linewise
  1238. (text &optional invisibly eob even-empty wait-last-prompt sleep-sec wait-sec)
  1239. "Evaluate TEXT in the ESS process buffer as if typed in w/o tabs.
  1240. Waits for prompt after each line of input, so won't break on large texts.
  1241. If optional second arg INVISIBLY is non-nil, don't echo commands.
  1242. If it is a string, just include that string. If optional third
  1243. arg EOB is non-nil go to end of ESS process buffer after
  1244. evaluation. If optional 4th arg EVEN-EMPTY is non-nil, also send
  1245. empty text (e.g. an empty line). If 5th arg WAIT-LAST-PROMPT is
  1246. non-nil, also wait for the prompt after the last line; if 6th arg
  1247. SLEEP-SEC is a number, ESS will call '(\\[sleep-for] SLEEP-SEC)
  1248. at the end of this function. If the 7th arg WAIT-SEC is set, it
  1249. will be used instead of the default .001s and be passed to
  1250. \\[ess-wait-for-process].
  1251. Run `comint-input-filter-functions' and
  1252. `ess-presend-filter-functions' of the associated PROCESS on the
  1253. TEXT."
  1254. (unless (numberp wait-sec)
  1255. (setq wait-sec 0.001))
  1256. (ess-force-buffer-current "Process to use: ")
  1257. ;; Use this to evaluate some code, but don't wait for output.
  1258. (let* ((deactivate-mark) ; keep local {do *not* deactivate wrongly}
  1259. (sprocess (ess-get-process ess-current-process-name))
  1260. (sbuffer (process-buffer sprocess))
  1261. (win (get-buffer-window sbuffer t)))
  1262. (setq text (ess--concat-new-line-maybe
  1263. (ess--run-presend-hooks sprocess text)))
  1264. (with-current-buffer sbuffer
  1265. (setq text (propertize text 'field 'input 'front-sticky t))
  1266. (goto-char (marker-position (process-mark sprocess)))
  1267. (if (stringp invisibly)
  1268. (insert-before-markers (concat "*** " invisibly " ***\n")))
  1269. ;; dbg:
  1270. ;; dbg (ess-write-to-dribble-buffer
  1271. ;; dbg (format "(eval-visibly 2): text[%d]= '%s'\n" (length text) text))
  1272. (while (or (> (length text) 0) even-empty)
  1273. (setq even-empty nil)
  1274. (let* ((pos (string-match "\n\\|$" text))
  1275. (input (if (= (length text) 0)
  1276. "\n"
  1277. (concat (substring text 0 pos) "\n"))))
  1278. (setq text (substring text (min (length text) (1+ pos))))
  1279. (goto-char (marker-position (process-mark sprocess)))
  1280. (if win (set-window-point win (process-mark sprocess)))
  1281. (unless invisibly
  1282. ;; for consistency with comint :(
  1283. (insert (propertize input 'font-lock-face 'comint-highlight-input))
  1284. (set-marker (process-mark sprocess) (point)))
  1285. (inferior-ess-mark-as-busy sprocess)
  1286. (process-send-string sprocess input))
  1287. (when (or (> (length text) 0)
  1288. wait-last-prompt)
  1289. (ess-wait-for-process sprocess t wait-sec)))
  1290. (if eob (with-temp-buffer (buffer-name sbuffer)))
  1291. (goto-char (marker-position (process-mark sprocess)))
  1292. (when win
  1293. (with-selected-window win
  1294. (goto-char (point))
  1295. ;; this is crucial to avoid resetting window-point
  1296. (recenter (- -1 scroll-margin))))))
  1297. (if (numberp sleep-sec)
  1298. (sleep-for sleep-sec)))
  1299. ;;;*;;; Evaluate only
  1300. (defun ess-eval-region--normalise-region (start end)
  1301. "Clean the region from START to END for evaluation.
  1302. This trims newlines at beginning and end of the region because
  1303. they might throw off the debugger."
  1304. (save-excursion
  1305. (goto-char start)
  1306. (skip-chars-forward "\n\t ")
  1307. (setq start (point))
  1308. (unless mark-active
  1309. (ess-blink-region start end))
  1310. (goto-char end)
  1311. (skip-chars-backward "\n\t ")
  1312. (setq end (point))))
  1313. (defun ess-eval-region (start end vis &optional message type)
  1314. "Send the region from START to END to the inferior ESS process.
  1315. VIS switches the meaning of `ess-eval-visibly'. If given,
  1316. MESSAGE is `message'ed. TYPE is a symbol indicating what type of
  1317. region this is. If command `rectangle-mark-mode' is active, send
  1318. the lines of the rectangle separately to the inferior process."
  1319. (interactive "r\nP")
  1320. (ess-force-buffer-current "Process to use: ")
  1321. (message "Starting evaluation...")
  1322. (unless ess-local-customize-alist
  1323. ;; External applications might call ess-eval-* functions; make it
  1324. ;; easier for them
  1325. (ess-setq-vars-local (symbol-value (ess-get-process-variable 'ess-local-customize-alist))))
  1326. (if (bound-and-true-p rectangle-mark-mode)
  1327. ;; If we're in rectangle-mark-mode, loop over each line of the
  1328. ;; rectangle. Send them separately.
  1329. (let ((reclines (extract-rectangle-bounds (min (mark) (point)) (max (mark) (point)))))
  1330. (mapc (lambda (l)
  1331. (ess--eval-region (car l) (cdr l) vis message type))
  1332. reclines))
  1333. (ess--eval-region start end vis message type)))
  1334. (defun ess--eval-region (start end vis &optional message type)
  1335. "Helper function for `ess-eval-region', which see.
  1336. START, END, VIS, MESSAGE, and TYPE described there."
  1337. (ess-eval-region--normalise-region start end)
  1338. (let ((visibly (if vis (not ess-eval-visibly) ess-eval-visibly))
  1339. (message (or message "Eval region"))
  1340. (proc (ess-get-process)))
  1341. (save-excursion
  1342. (ess-send-region proc start end visibly message type)))
  1343. (when ess-eval-deactivate-mark
  1344. (ess-deactivate-mark))
  1345. (list start end))
  1346. (defun ess-eval-buffer (&optional vis)
  1347. "Send the current buffer to the inferior ESS process.
  1348. VIS has same meaning as for `ess-eval-region'."
  1349. (interactive "P")
  1350. (ess-eval-region (point-min) (point-max) vis "Eval buffer" 'buffer))
  1351. (defun ess-eval-buffer-from-beg-to-here (&optional vis)
  1352. "Send region from beginning to point to the inferior ESS process.
  1353. VIS has same meaning as for `ess-eval-region'."
  1354. (interactive "P")
  1355. (ess-eval-region (point-min) (point) vis "Eval buffer till point"))
  1356. (defun ess-eval-buffer-from-here-to-end (&optional vis)
  1357. "Send region from point to end of buffer to the inferior ESS process.
  1358. VIS has same meaning as for `ess-eval-region'."
  1359. (interactive "P")
  1360. (ess-eval-region (point) (point-max) vis "Eval buffer till end"))
  1361. (defun ess-eval-function (&optional vis)
  1362. "Send the current function to the inferior ESS process.
  1363. Prefix arg VIS toggles visibility of ess-code as for
  1364. `ess-eval-region'. Returns nil if not inside a function."
  1365. (interactive "P")
  1366. (ess-force-buffer-current)
  1367. (save-excursion
  1368. (ignore-errors
  1369. ;; Evaluation is forward oriented
  1370. (forward-line -1)
  1371. (ess-next-code-line 1))
  1372. (let ((pos (point))
  1373. beg end msg)
  1374. (end-of-defun)
  1375. (beginning-of-defun)
  1376. ;; While we are the beginning of the function, get the function
  1377. ;; name. FIXME: should use our ess-function-pattern.
  1378. (setq msg (format "Eval function: %s"
  1379. (if (looking-at add-log-current-defun-header-regexp)
  1380. (match-string 1)
  1381. (buffer-substring (point) (point-at-eol)))))
  1382. (setq beg (point))
  1383. (end-of-defun)
  1384. (setq end (point))
  1385. (when (or (< pos beg)
  1386. (< end pos))
  1387. (error "Not in a function"))
  1388. (if (ess-tracebug-p)
  1389. (ess-tracebug-send-function (get-process ess-local-process-name) beg end vis msg)
  1390. (ess-eval-region beg end vis msg)))))
  1391. (defun ess-eval-paragraph (&optional vis)
  1392. "Send the current paragraph to the inferior ESS process.
  1393. Prefix arg VIS toggles visibility of ess-code as for `ess-eval-region'."
  1394. (interactive "P")
  1395. (let ((start-pos (point)))
  1396. (if (= (point-at-bol) (point-min))
  1397. (ess-next-code-line 0)
  1398. ;; Evaluation is forward oriented
  1399. (forward-line -1)
  1400. (ess-next-code-line 1))
  1401. (when (< (point) start-pos)
  1402. (goto-char start-pos))
  1403. (save-excursion
  1404. (let ((beg (progn (backward-paragraph) (point)))
  1405. (end (progn (forward-paragraph) (point))))
  1406. (ess-eval-region beg end vis)))))
  1407. (defun ess-eval-function-or-paragraph (&optional vis)
  1408. "Send the current function if \\[point] is inside one.
  1409. Otherwise send the current paragraph to the inferior ESS process.
  1410. Prefix arg VIS toggles visibility of ess-code as for
  1411. `ess-eval-region'. Returns 'function if a function was evaluated
  1412. or 'paragraph if a paragraph."
  1413. (interactive "P")
  1414. (condition-case nil
  1415. (progn (ess-eval-function vis)
  1416. 'function)
  1417. ;; TODO: Maybe be smarter than just catching all errors?
  1418. (error (ess-eval-paragraph vis)
  1419. 'paragraph)))
  1420. (defun ess-eval-function-or-paragraph-and-step (&optional vis)
  1421. "Send the current function if \\[point] is inside one.
  1422. Otherwise send the current paragraph to the inferior ESS process.
  1423. Prefix arg VIS toggles visibility of ess-code as for
  1424. `ess-eval-region'."
  1425. (interactive "P")
  1426. (ess-skip-thing (ess-eval-function-or-paragraph vis))
  1427. (ess-next-code-line))
  1428. (defun ess-eval-region-or-function-or-paragraph (&optional vis)
  1429. "Send the region, function, or paragraph depending on context.
  1430. Send the region if it is active. If not, send function if `point'
  1431. is inside one, otherwise the current paragraph. Treats
  1432. rectangular regions as `ess-eval-region' does. Prefix arg VIS
  1433. toggles visibility of ess-code as for `ess-eval-region'."
  1434. (interactive "P")
  1435. (if (use-region-p)
  1436. (ess-eval-region (region-beginning) (region-end) vis)
  1437. (ess-eval-function-or-paragraph vis)))
  1438. (defun ess-eval-region-or-function-or-paragraph-and-step (&optional vis)
  1439. "Send the region, function, or paragraph depending on context.
  1440. Send the region if it is active. If not, send function if `point'
  1441. is inside one, otherwise the current paragraph. Treats
  1442. rectangular regions as `ess-eval-region' does. After evaluation
  1443. step to the next code line or to the end of region if region was
  1444. active. Prefix arg VIS toggles visibility of ess-code as for
  1445. `ess-eval-region'."
  1446. (interactive "P")
  1447. (ess-skip-thing (ess-eval-region-or-function-or-paragraph vis))
  1448. (ess-next-code-line))
  1449. (defun ess-eval-region-or-line-and-step (&optional vis)
  1450. "Evaluate region if active, otherwise `ess-eval-line-and-step'.
  1451. See `ess-eval-region' for the meaning of VIS. Treats rectangular
  1452. regions as `ess-eval-region' does."
  1453. (interactive "P")
  1454. (if (use-region-p)
  1455. (ess-eval-region (region-beginning) (region-end) vis)
  1456. (ess-eval-line-and-step)))
  1457. (defun ess-eval-region-or-line-visibly-and-step ()
  1458. "Evaluate region if active, otherwise the current line and step.
  1459. Evaluation is done visibly.
  1460. Note that when inside a package and namespaced evaluation is in
  1461. place (see `ess-r-set-evaluation-env') evaluation of multiline
  1462. input will fail."
  1463. (interactive)
  1464. (ess-force-buffer-current)
  1465. (display-buffer (ess-get-process-buffer)
  1466. ;; Use a different window for the process buffer:
  1467. '(nil (inhibit-same-window . t))
  1468. ;; Pass t to reusable-frames if users have help in
  1469. ;; own frames, otherwise help frames get split to
  1470. ;; display the inferior.
  1471. (or (equal ess-help-own-frame 'one)
  1472. ess-help-own-frame))
  1473. (let ((ess-eval-visibly t))
  1474. (ess-eval-region-or-line-and-step)))
  1475. (defun ess-eval-line (&optional vis)
  1476. "Send the current line to the inferior ESS process.
  1477. VIS has same meaning as for `ess-eval-region'."
  1478. (interactive "P")
  1479. (let* ((beg (point-at-bol))
  1480. (end (point-at-eol))
  1481. (msg (format "Loading line: %s" (buffer-substring beg end))))
  1482. (ess-eval-region beg end vis msg)))
  1483. (defun ess-eval-line-and-step (&optional vis)
  1484. "Evaluate the current line and step to the \"next\" line.
  1485. See `ess-eval-region' for VIS."
  1486. (interactive "P")
  1487. (ess-eval-line vis)
  1488. (ess-skip-thing 'line)
  1489. (ess-next-code-line))
  1490. (defun ess-eval-line-visibly-and-step (&optional simple-next)
  1491. "Evaluate the current line visibly and step to the \"next\" line.
  1492. If SIMPLE-NEXT is non-nil, possibly via prefix arg, first skip
  1493. empty and commented lines. When the variable `ess-eval-empty'
  1494. is non-nil both SIMPLE-NEXT and EVEN-EMPTY are interpreted as
  1495. true.
  1496. Note that when inside a package and namespaced evaluation is in
  1497. place (see `ess-r-set-evaluation-env'), the evaluation of
  1498. multiline input will fail."
  1499. (interactive "P")
  1500. (ess-force-buffer-current)
  1501. (display-buffer (ess-get-process-buffer)
  1502. ;; Use a different window for the process buffer:
  1503. '(nil (inhibit-same-window . t))
  1504. ;; Pass t to reusable-frames if users have help in
  1505. ;; own frames, otherwise help frames get split to
  1506. ;; display the inferior.
  1507. (or (equal ess-help-own-frame 'one)
  1508. ess-help-own-frame))
  1509. (let ((ess-eval-visibly t)
  1510. (ess-eval-empty (or ess-eval-empty simple-next)))
  1511. (ess-eval-line)
  1512. (ess-skip-thing 'line)
  1513. (ess-next-code-line)))
  1514. (defun ess-eval-line-invisibly-and-step ()
  1515. "Evaluate the current line invisibly and step to the next line.
  1516. Evaluate all comments and empty lines."
  1517. (interactive)
  1518. (let ((ess-eval-visibly nil))
  1519. (ess-eval-line-and-step)))
  1520. (define-obsolete-function-alias 'ess-eval-line-and-step-invisibly 'ess-eval-line-invisibly-and-step "18.10")
  1521. ;;;*;;; Evaluate and switch to S
  1522. (defun ess-eval-region-and-go (start end &optional vis)
  1523. "Send region from START to END to the inferior process buffer.
  1524. START and END default to the current region, and rectangular
  1525. regions are treated as `ess-eval-region'. VIS has same meaning as
  1526. for `ess-eval-region'."
  1527. (interactive "r\nP")
  1528. (ess-eval-region start end vis)
  1529. (ess-switch-to-ESS t))
  1530. (defun ess-eval-buffer-and-go (&optional vis)
  1531. "Send the current buffer to the inferior S and switch to the process buffer.
  1532. VIS has same meaning as for `ess-eval-region'."
  1533. (interactive "P")
  1534. (ess-eval-buffer vis)
  1535. (ess-switch-to-ESS t))
  1536. (defun ess-eval-function-and-go (&optional vis)
  1537. "Send the current function, then switch to the inferior process buffer.
  1538. VIS has same meaning as for `ess-eval-region'."
  1539. (interactive "P")
  1540. (ess-eval-function vis)
  1541. (ess-switch-to-ESS t))
  1542. (defun ess-eval-line-and-go (&optional vis)
  1543. "Send the current line, then switch to the inferior process buffer.
  1544. VIS has same meaning as for `ess-eval-region'."
  1545. (interactive "P")
  1546. (ess-eval-line vis)
  1547. (ess-switch-to-ESS t))
  1548. (defun ess-eval-paragraph-and-go (&optional vis)
  1549. "Send the current paragraph, then switch to the inferior process buffer.
  1550. VIS has same meaning as for `ess-eval-region'."
  1551. (interactive "P")
  1552. (ess-eval-paragraph vis)
  1553. (ess-switch-to-ESS t))
  1554. (defun ess-eval-paragraph-and-step (&optional vis)
  1555. "Evaluate the current paragraph and move point to the next line.
  1556. If not inside a paragraph, evaluate the next one. VIS has same
  1557. meaning as for `ess-eval-region'."
  1558. (interactive "P")
  1559. (ess-eval-paragraph vis)
  1560. (ess-skip-thing 'paragraph)
  1561. (ess-next-code-line))
  1562. ; Inferior ESS mode
  1563. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1564. ;;;; In this section:
  1565. ;;;;
  1566. ;;;; * The major mode inferior-ess-mode
  1567. ;;;; * Process handling code
  1568. ;;;; * Completion code
  1569. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1570. ;;*;; Major mode definition
  1571. (defvar inferior-ess-mode-map
  1572. (let ((map (make-sparse-keymap)))
  1573. (define-key map "\C-y" #'ess-yank)
  1574. (define-key map "\r" #'inferior-ess-send-input)
  1575. (define-key map "\C-a" #'comint-bol)
  1576. ;; 2010-06-03 SJE
  1577. ;; disabled this in favor of ess-dirs. Martin was not sure why this
  1578. ;; key was defined anyway in this mode.
  1579. ;;(define-key map "\M-\r" #'ess-transcript-send-command-and-move)
  1580. (define-key map "\C-c\M-l" #'ess-load-file)
  1581. (define-key map "\C-c`" #'ess-show-traceback)
  1582. (define-key map [(control ?c) ?~] #'ess-show-call-stack)
  1583. (define-key map "\C-c\C-d" #'ess-dump-object-into-edit-buffer)
  1584. (define-key map "\C-c\C-v" #'ess-display-help-on-object)
  1585. (define-key map "\C-c\C-q" #'ess-quit)
  1586. (define-key map "\C-c\C-s" #'ess-execute-search)
  1587. (define-key map "\C-c\C-x" #'ess-execute-objects)
  1588. (define-key map "\C-c\034" #'ess-abort) ; \C-c\C-backslash
  1589. (define-key map "\C-c\C-z" #'ess-switch-to-inferior-or-script-buffer) ; mask comint map
  1590. (define-key map "\C-d" #'delete-char) ; EOF no good in S
  1591. (define-key map "\t" #'completion-at-point)
  1592. (define-key map "\M-?" #'ess-complete-object-name)
  1593. (define-key map "\C-c\C-k" #'ess-request-a-process)
  1594. (define-key map "," #'ess-smart-comma)
  1595. (define-key map "\C-c\C-d" 'ess-doc-map)
  1596. (define-key map "\C-c\C-e" 'ess-extra-map)
  1597. (define-key map "\C-c\C-t" 'ess-dev-map)
  1598. map)
  1599. "Keymap for `inferior-ess' mode.")
  1600. (easy-menu-define
  1601. inferior-ess-mode-menu inferior-ess-mode-map
  1602. "Menu for use in Inferior S mode"
  1603. '("iESS"
  1604. ["Quit" ess-quit t]
  1605. ["Reload process" inferior-ess-reload t]
  1606. ;; ["Send and move" ess-transcript-send-command-and-move t]
  1607. ["Copy command" comint-copy-old-input t]
  1608. ["Send command" inferior-ess-send-input t]
  1609. ["Switch to script buffer" ess-switch-to-inferior-or-script-buffer t]
  1610. ["Get help on S object" ess-display-help-on-object t]
  1611. "------"
  1612. ("Process"
  1613. ["Process Echoes" (lambda () (interactive)
  1614. (setq comint-process-echoes (not comint-process-echoes)))
  1615. :active t
  1616. :style toggle
  1617. :selected comint-process-echoes]
  1618. ("Eval visibly "
  1619. :filter ess--generate-eval-visibly-submenu ))
  1620. "------"
  1621. ("Utils"
  1622. ["Attach directory" ess-execute-attach t]
  1623. ["Display object list" ess-execute-objects t]
  1624. ["Display search list" ess-execute-search t]
  1625. ["Edit S object" ess-dump-object-into-edit-buffer t]
  1626. ["Enter S command" ess-execute t]
  1627. ["Jump to error" ess-parse-errors t]
  1628. ["Load source file" ess-load-file t]
  1629. ["Resynch S completions" ess-resynch t]
  1630. ["Recreate R versions known to ESS"
  1631. (lambda () (interactive) (ess-r-redefine-runners 'verbose)) t]
  1632. )
  1633. "------"
  1634. ("start-dev" :visible nil); <-- ??
  1635. ("end-dev" :visible nil)
  1636. "------"
  1637. ("Font Lock"
  1638. :active ess-font-lock-keywords
  1639. :filter ess--generate-font-lock-submenu)
  1640. "------"
  1641. ["Describe" describe-mode t]
  1642. ["Send bug report" ess-submit-bug-report t]
  1643. ["About" (ess-goto-info "Entering Commands") t]
  1644. ))
  1645. (defvar ess-mode-minibuffer-map
  1646. (let ((map (make-sparse-keymap)))
  1647. (set-keymap-parent map minibuffer-local-map)
  1648. (define-key map "\t" #'ess-complete-object-name)
  1649. (define-key map "\C-\M-i" #'ess-complete-object-name) ;; doesn't work:(
  1650. (define-key map "\C-c\C-s" #'ess-execute-search)
  1651. (define-key map "\C-c\C-x" #'ess-execute-objects)
  1652. map)
  1653. "Keymap used in `ess-execute'.")
  1654. (define-derived-mode inferior-ess-mode comint-mode "iESS"
  1655. "Major mode for interacting with an inferior ESS process.
  1656. To learn more about how to use inferior ess modes, see Info
  1657. node `(ess)Top'. If you accidentally suspend your process, use
  1658. \\[comint-continue-subjob] to continue it."
  1659. :group 'ess-proc
  1660. (setq-local comint-input-sender 'inferior-ess-input-sender)
  1661. (setq-local font-lock-fontify-region-function
  1662. #'inferior-ess-fontify-region)
  1663. ;; If comint-process-echoes is t inferior-ess-input-sender
  1664. ;; recopies the input, otherwise not
  1665. (setq-local comint-process-echoes (not (member ess-language '("SAS" "XLS" "OMG" "julia"))))
  1666. (when comint-use-prompt-regexp ;; why comint is not setting this? bug?
  1667. (setq-local inhibit-field-text-motion t))
  1668. (unless inferior-ess-prompt ;; build when unset
  1669. (setq inferior-ess-prompt
  1670. (concat "\\("
  1671. inferior-ess-primary-prompt
  1672. (when inferior-ess-secondary-prompt "\\|")
  1673. inferior-ess-secondary-prompt
  1674. "\\)")))
  1675. (setq comint-prompt-regexp (concat "^" inferior-ess-prompt))
  1676. (setq mode-line-process
  1677. '(" ["
  1678. ess--mode-line-process-indicator
  1679. ess--local-mode-line-process-indicator
  1680. "]: %s"))
  1681. ;;; Completion support ----------------
  1682. (remove-hook 'completion-at-point-functions 'comint-completion-at-point t) ;; reset the hook
  1683. (add-hook 'completion-at-point-functions 'comint-c-a-p-replace-by-expanded-history nil 'local)
  1684. (add-hook 'completion-at-point-functions 'ess-filename-completion nil 'local)
  1685. ;; hyperlinks support
  1686. (goto-address-mode t)
  1687. ;; Avoid spaces after filenames
  1688. (setq-local comint-completion-addsuffix (cons "/" ""))
  1689. (setq comint-input-autoexpand t) ; Only for completion, not on input.
  1690. (add-hook 'window-configuration-change-hook #'ess-set-width nil t)
  1691. (setq-local indent-tabs-mode nil)
  1692. (setq-local paragraph-start (concat inferior-ess-primary-prompt "\\|\^L"))
  1693. (setq-local paragraph-separate "\^L")
  1694. (setq-local jit-lock-chunk-size inferior-ess-jit-lock-chunk-size))
  1695. ;;*;; Commands used exclusively in inferior-ess-mode
  1696. ;;;*;;; Main user commands
  1697. (defun inferior-ess-input-sender (proc string)
  1698. (inferior-ess--interrupt-subjob-maybe proc)
  1699. (let ((comint-input-filter-functions nil)) ; comint runs them, don't run twice.
  1700. (if comint-process-echoes
  1701. (ess-eval-linewise string nil nil ess-eval-empty)
  1702. (ess-send-string proc string))))
  1703. (defvar ess-help-arg-regexp "\\(['\"]?\\)\\([^,=)'\"]*\\)\\1"
  1704. "Reg(ular) Ex(pression) of help(.) arguments. MUST: 2nd \\(.\\) = arg.")
  1705. (defun inferior-ess-send-input ()
  1706. "Sends the command on the current line to the ESS process."
  1707. (interactive)
  1708. (run-hooks 'ess-send-input-hook)
  1709. (unless (ess-process-get 'busy)
  1710. ;; avoid new line insertion
  1711. (ess-process-put 'prev-prompt nil))
  1712. (comint-send-input)
  1713. (setq ess-object-list nil))
  1714. (defun inferior-ess--goto-input-start:field ()
  1715. "Move point to the beginning of input skipping all continuation lines.
  1716. If in the output field, goes to the beginning of previous input
  1717. field.
  1718. Note: `inferior-ess-secondary-prompt' should match exactly."
  1719. (goto-char (field-beginning))
  1720. ;; move to the beginning of non-output field
  1721. (while (and (not (bobp))
  1722. (eq (field-at-pos (point)) 'output))
  1723. (goto-char (field-beginning nil t)))
  1724. ;; skip all secondary prompts
  1725. (let ((pos (field-beginning (point) t))
  1726. (secondary-prompt (concat "^" inferior-ess-secondary-prompt)))
  1727. (while (and pos
  1728. (if (eq (get-text-property pos 'field) 'output)
  1729. (string-match secondary-prompt (field-string-no-properties pos))
  1730. t))
  1731. (goto-char pos)
  1732. (setq pos (previous-single-property-change pos 'field)))))
  1733. (defun inferior-ess--goto-input-end:field ()
  1734. "Move point to the end of input skipping all continuation lines.
  1735. If in the output field, goes to the beginning of previous input
  1736. field. NOTE: to be used only with fields, see
  1737. `comint-use-prompt-regexp'."
  1738. ;; this func is not used but might be useful some day
  1739. (goto-char (field-end))
  1740. (let ((pos (point))
  1741. (secondary-prompt (concat "^" inferior-ess-secondary-prompt)))
  1742. (while (and pos
  1743. (if (eq (get-text-property pos 'field) 'output)
  1744. (string-match secondary-prompt (field-string-no-properties pos))
  1745. t))
  1746. (goto-char pos)
  1747. (setq pos (next-single-property-change pos 'field)))))
  1748. (defun inferior-ess--get-old-input:field ()
  1749. "Return the ESS command surrounding point (use with fields)."
  1750. (save-excursion
  1751. (if (eq (field-at-pos (point)) 'output)
  1752. (if (called-interactively-p 'any)
  1753. (error "No command on this line")
  1754. ;; else, just return ""
  1755. "")
  1756. (inferior-ess--goto-input-start:field)
  1757. (let ((command (field-string-no-properties (point)))
  1758. (pos (next-single-property-change (point) 'field ))
  1759. (secondary-prompt (concat "^" inferior-ess-secondary-prompt)))
  1760. (while (and pos
  1761. (cond
  1762. ((eq (get-text-property pos 'field) 'input)
  1763. (setq command (concat command "\n" (field-string-no-properties pos))))
  1764. ((eq (get-text-property pos 'field) 'output)
  1765. (string-match secondary-prompt (field-string-no-properties pos)))
  1766. (t)));; just skip if unknown
  1767. (setq pos (next-single-property-change pos 'field)))
  1768. command))))
  1769. ;; TODO: error when entering a multiline function
  1770. ;; check.integer <- function(N){
  1771. ;; is.integer(N) | !length(grep("[^[:digit:]]", as.character(N)))
  1772. ;; }
  1773. (defun inferior-ess--goto-input-start:regexp ()
  1774. "Move point to the beginning of input skipping all continuation lines.
  1775. If in the output field, goes to the beginning of previous input."
  1776. (beginning-of-line)
  1777. (unless (looking-at inferior-ess-prompt)
  1778. (re-search-backward (concat "^" inferior-ess-prompt) nil t))
  1779. ;; at bol
  1780. (when (and inferior-ess-secondary-prompt
  1781. (looking-at inferior-ess-secondary-prompt))
  1782. (while (and (> (forward-line -1) -1)
  1783. (looking-at inferior-ess-secondary-prompt))))
  1784. (unless (looking-at inferior-ess-prompt)
  1785. (error "Beginning of input not found"))
  1786. (comint-skip-prompt))
  1787. (defun inferior-ess--get-old-input:regexp ()
  1788. "Return the ESS command surrounding point (use regexp)."
  1789. ;;VS[03-09-2012]: This should not rise errors!! Troubles comint-interrupt-subjob
  1790. (save-excursion
  1791. (let* ((inhibit-field-text-motion t)
  1792. command)
  1793. (beginning-of-line)
  1794. (when (and inferior-ess-secondary-prompt
  1795. (looking-at inferior-ess-secondary-prompt))
  1796. (inferior-ess--goto-input-start:regexp))
  1797. (beginning-of-line)
  1798. (if (looking-at inferior-ess-prompt) ; cust.var, might not include sec-prompt
  1799. (progn
  1800. (comint-skip-prompt)
  1801. (setq command (buffer-substring-no-properties (point) (point-at-eol)))
  1802. (when inferior-ess-secondary-prompt
  1803. (while (progn (forward-line 1)
  1804. (looking-at inferior-ess-secondary-prompt))
  1805. (re-search-forward inferior-ess-secondary-prompt (point-at-eol) t)
  1806. (setq command (concat command "\n"
  1807. (buffer-substring-no-properties (point) (point-at-eol))))))
  1808. (forward-line -1)
  1809. command)
  1810. (message "No command at this point")
  1811. ""))))
  1812. (defun inferior-ess-get-old-input ()
  1813. "Return the ESS command surrounding point."
  1814. (if comint-use-prompt-regexp
  1815. (inferior-ess--get-old-input:regexp)
  1816. (inferior-ess--get-old-input:field)))
  1817. ;;;*;;; Hot key commands
  1818. (defun ess-execute-objects (posn)
  1819. "Send the objects() command to the ESS process.
  1820. By default, gives the objects at position 1.
  1821. A prefix argument toggles the meaning of `ess-execute-in-process-buffer'.
  1822. A prefix argument of 2 or more means get objects for that position.
  1823. A negative prefix argument gets the objects for that position
  1824. and toggles `ess-execute-in-process-buffer' as well."
  1825. (interactive "P")
  1826. (ess-make-buffer-current)
  1827. (let* ((num-arg (if (listp posn)
  1828. (if posn -1 1)
  1829. (prefix-numeric-value posn)))
  1830. (the-posn (if (< num-arg 0) (- num-arg) num-arg))
  1831. (invert (< num-arg 0))
  1832. (the-command (format inferior-ess-objects-command the-posn ".*"))
  1833. (the-message (concat ">>> Position "
  1834. (number-to-string the-posn)
  1835. " ("
  1836. (nth (1- the-posn) (ess-search-list))
  1837. ")\n")))
  1838. (ess-execute the-command invert "S objects" the-message)))
  1839. (defun ess-execute-search (invert)
  1840. "Send the `inferior-ess-search-list-command' command to the `ess-language' process.
  1841. [search(..) in S]"
  1842. (interactive "P")
  1843. (ess-execute inferior-ess-search-list-command invert "S search list"))
  1844. ;; FIXME --- this *only* works in S / S-plus; not in R
  1845. ;; ----- ("at least" is not assigned to any key by default)
  1846. (defun ess-execute-attach (dir &optional posn)
  1847. "Attach a directory in the `ess-language' process with the attach() command.
  1848. When used interactively, user is prompted for DIR to attach and
  1849. prefix argument is used for POSN (or 2, if absent.)
  1850. Doesn't work for data frames."
  1851. (interactive "Attach directory: \nP")
  1852. (ess-execute (concat "attach(\""
  1853. (directory-file-name (expand-file-name dir))
  1854. "\""
  1855. (if posn (concat "," (number-to-string
  1856. (prefix-numeric-value posn))))
  1857. ")") 'buffer)
  1858. (ess-process-put 'sp-for-help-changed? t))
  1859. (defun ess-execute-screen-options (&optional invisibly)
  1860. "Cause S to set the \"width\" option to 1 less than the window width.
  1861. Also sets the \"length\" option to 99999. When INVISIBLY is
  1862. non-nil, don't echo to R subprocess. This is a good thing to put
  1863. in `ess-r-post-run-hook' or `ess-S+-post-run-hook'."
  1864. (interactive)
  1865. (if (null ess-execute-screen-options-command)
  1866. (message "Not implemented for '%s'" ess-dialect)
  1867. (let ((command (ess-calculate-width 'window)))
  1868. (if invisibly
  1869. (ess-command command)
  1870. (ess-eval-linewise command nil nil nil 'wait-prompt)))))
  1871. (defun ess-calculate-width (opt)
  1872. "Calculate width command given OPT.
  1873. OPT can be 'window, 'frame, or an integer. Return a command
  1874. suitable to send to the inferior process (e.g. \"options(width=80, length=999999)\")."
  1875. (when (null ess-execute-screen-options-command)
  1876. (error "Not implemented for %s" ess-dialect))
  1877. (let (command)
  1878. (cond ((integerp opt)
  1879. (setq command (format ess-execute-screen-options-command opt)))
  1880. ((eql 'window opt)
  1881. ;; We cannot use (window-width) here because it returns sizes
  1882. ;; in default (frame) characters which leads to incorrect
  1883. ;; sizes with scaled fonts.To solve this we approximate font
  1884. ;; width in pixels and use window-pixel-width to compute the
  1885. ;; approximate number of characters that fit into line.
  1886. (let* ((wedges (window-inside-pixel-edges))
  1887. (wwidth (- (nth 2 wedges) (nth 0 wedges)))
  1888. (nchars (floor (/ wwidth (default-font-width)))))
  1889. (setq command (format ess-execute-screen-options-command
  1890. nchars))))
  1891. ((eql 'frame opt)
  1892. (setq command
  1893. (format ess-execute-screen-options-command (frame-width))))
  1894. (t (error "OPT (%s) not 'window, 'frame or an integer" opt)))
  1895. command))
  1896. (defun ess-set-width ()
  1897. "Set the width option.
  1898. A part of `window-configuration-change-hook' in inferior ESS
  1899. buffers."
  1900. (when (and ess-auto-width
  1901. ess-execute-screen-options-command)
  1902. ;; `window-configuration-change-hook' runs with the window selected.
  1903. (let ((proc (get-buffer-process (window-buffer)))
  1904. command)
  1905. ;; TODO: Set the width once the process is no longer busy.
  1906. (when (and (process-live-p proc)
  1907. (not (process-get proc 'busy)))
  1908. (setq command (ess-calculate-width ess-auto-width))
  1909. (if ess-auto-width-visible
  1910. (ess-eval-linewise command nil nil nil 'wait-prompt)
  1911. (ess-command command))))))
  1912. (defun ess-execute (command &optional invert buff message)
  1913. "Send a command to the ESS process.
  1914. A newline is automatically added to COMMAND. Prefix arg (or second arg
  1915. INVERT) means invert the meaning of
  1916. `ess-execute-in-process-buffer'. If INVERT is 'buffer, output is
  1917. forced to go to the process buffer. If the output is going to a
  1918. buffer, name it *BUFF*. This buffer is erased before use. Optional
  1919. fourth arg MESSAGE is text to print at the top of the buffer (defaults
  1920. to the command if BUFF is not given.)"
  1921. (interactive (list
  1922. ;; simpler way to set proc name in mb?
  1923. (let ((enable-recursive-minibuffers t)
  1924. (proc-name (progn (ess-force-buffer-current)
  1925. ess-local-process-name)))
  1926. (with-current-buffer (get-buffer " *Minibuf-1*") ;; FIXME: hardcoded name
  1927. (setq ess-local-process-name proc-name))
  1928. (read-from-minibuffer "Execute> " nil
  1929. ess-mode-minibuffer-map))
  1930. current-prefix-arg))
  1931. (ess-make-buffer-current)
  1932. (let ((the-command (concat command "\n"))
  1933. (buff-name (concat "*" (or buff "ess-output") "*"))
  1934. (in-pbuff (if invert (or (eq invert 'buffer)
  1935. (not ess-execute-in-process-buffer))
  1936. ess-execute-in-process-buffer)))
  1937. (if in-pbuff
  1938. (ess-eval-linewise the-command)
  1939. (ess-with-current-buffer (get-buffer-create buff-name)
  1940. (ess-command the-command (current-buffer) nil nil nil
  1941. (get-process ess-local-process-name))
  1942. (ansi-color-apply-on-region (point-min) (point-max))
  1943. (goto-char (point-min))
  1944. (if message (insert message)
  1945. (insert "> " the-command))
  1946. (display-buffer (current-buffer))))))
  1947. ;;;*;;; Quitting
  1948. (cl-defgeneric ess-quit--override (_arg)
  1949. "Stops the inferior process"
  1950. (let ((proc (ess-get-process)))
  1951. (ess-cleanup)
  1952. (goto-char (marker-position (process-mark proc)))
  1953. (insert inferior-ess-exit-command)
  1954. (process-send-string proc inferior-ess-exit-command)))
  1955. (defun ess-quit (&optional arg)
  1956. "Issue an exiting command to the inferior process.
  1957. Runs `ess-cleanup'. ARG gets passed to a language specific
  1958. method, see `ess-quit--override'."
  1959. (interactive "P")
  1960. (unless (ess-process-live-p)
  1961. (user-error "No live ESS process associated with this buffer"))
  1962. (ess-force-buffer-current "Process to quit: ")
  1963. (ess-interrupt)
  1964. (ess-make-buffer-current)
  1965. (ess-quit--override arg))
  1966. (defun ess-interrupt ()
  1967. "Interrupt the inferior process.
  1968. This sends an interrupt and quits a debugging session."
  1969. (interactive)
  1970. (inferior-ess-force)
  1971. (let ((proc (ess-get-process)))
  1972. ;; Interrupt current task before reloading. Useful if the process is
  1973. ;; prompting for input, for instance in R in case of a crash
  1974. (interrupt-process proc comint-ptyp)
  1975. ;; Workaround for Windows terminals
  1976. (unless (memq system-type '(gnu/linux darwin))
  1977. (process-send-string nil "\n"))
  1978. (ess-wait-for-process proc)
  1979. ;; Quit debugging session before reloading
  1980. (when (ess-debug-active-p)
  1981. (ess-debug-command-quit)
  1982. (ess-wait-for-process proc))))
  1983. (defun ess-abort ()
  1984. "Kill the ESS process, without executing .Last or terminating devices.
  1985. If you want to finish your session, use \\[ess-quit] instead."
  1986. ;;; Provided as a safety measure over the default binding of C-c C-z in
  1987. ;;; comint-mode-map.
  1988. (interactive)
  1989. (ding)
  1990. (message "WARNING: \\[inferior-ess-exit-command] will not be executed and graphics devices won't finish properly!")
  1991. (sit-for 2)
  1992. (if (y-or-n-p "Still abort? ")
  1993. (comint-quit-subjob)
  1994. (message "Good move.")))
  1995. (defun ess-cleanup ()
  1996. "Cleanup buffers associated with the process.
  1997. Possibly kill or offer to kill, depending on the value of
  1998. `ess-S-quit-kill-buffers-p', all buffers associated with this ESS
  1999. process. Uses `display-buffer' to display the process buffer. It
  2000. is run automatically by \\[ess-quit]."
  2001. (interactive)
  2002. (let* ((the-procname (or (ess-make-buffer-current) ess-local-process-name))
  2003. (buf (buffer-name (process-buffer (get-process the-procname)))))
  2004. (unless the-procname
  2005. (error "I don't know which ESS process to clean up after!"))
  2006. (when
  2007. (or (eq ess-S-quit-kill-buffers-p t)
  2008. (and
  2009. (eq ess-S-quit-kill-buffers-p 'ask)
  2010. (y-or-n-p
  2011. (format
  2012. "Delete all buffers associated with process %s? " the-procname))))
  2013. (dolist (buf (buffer-list))
  2014. (with-current-buffer buf
  2015. ;; Consider buffers for which ess-local-process-name is
  2016. ;; the same as the-procname
  2017. (when (and (not (get-buffer-process buf))
  2018. ess-local-process-name
  2019. (equal ess-local-process-name the-procname))
  2020. (kill-buffer buf)))))
  2021. (display-buffer buf)
  2022. buf))
  2023. (defun inferior-ess-reload (&optional start-args)
  2024. "Reload the inferior process.
  2025. START-ARGS gets passed to the dialect-specific
  2026. `inferior-ess-reload-override'."
  2027. (interactive)
  2028. (let* ((inf-buf (inferior-ess-force))
  2029. (inf-proc (get-buffer-process inf-buf))
  2030. (inf-start-data (buffer-local-value 'inferior-ess--local-data inf-buf))
  2031. (start-name (car inf-start-data))
  2032. (start-args (or start-args (cdr inf-start-data))))
  2033. ;; Interrupt early so we can get working directory
  2034. (ess-interrupt)
  2035. (save-window-excursion
  2036. ;; Make sure we don't ask for directory again
  2037. ;; Use current working directory as default
  2038. (let ((project-find-functions nil)
  2039. (ess-directory-function nil)
  2040. (ess-startup-directory (ess-get-working-directory))
  2041. (ess-ask-for-ess-directory nil))
  2042. (ess-quit 'no-save)
  2043. (inferior-ess--wait-for-exit inf-proc)
  2044. (with-current-buffer inf-buf
  2045. (inferior-ess-reload--override start-name start-args))))))
  2046. (cl-defgeneric inferior-ess-reload--override (_start-name _start-args)
  2047. (user-error "Reloading not implemented for %s" ess-dialect))
  2048. (defun inferior-ess--wait-for-exit (proc)
  2049. "Wait for process exit.
  2050. This should be used instead of `ess-wait-for-process' for waiting
  2051. after issuing a quit command as the latter assumes a live process."
  2052. (let ((start-time (float-time)))
  2053. (while (eq (process-status proc) 'run)
  2054. (accept-process-output proc 0.002)
  2055. (when (> (- (float-time) start-time) 1)
  2056. (error "Timeout while quitting process")))))
  2057. ;;;*;;; Support functions
  2058. (defun ess-extract-onames-from-alist (alist posn &optional force)
  2059. "Return the object names in position POSN of ALIST.
  2060. ALIST is an alist like `ess-sl-modtime-alist'. POSN should be in 1 .. (length
  2061. ALIST). If optional third arg FORCE is t, the corresponding element
  2062. of the search list is re-read. Otherwise it is only re-read if it's a
  2063. directory and has been modified since it was last read."
  2064. (let* ((entry (nth (1- posn) alist))
  2065. (dir (car entry))
  2066. (timestamp (car (cdr entry)))
  2067. (new-modtime (and timestamp
  2068. (ess-dir-modtime dir))))
  2069. ;; Refresh the object listing if necessary
  2070. (if (or force (not (equal new-modtime timestamp)))
  2071. (setcdr (cdr entry) (ess-object-names dir posn)))
  2072. (cdr (cdr entry))))
  2073. (defun ess-dir-modtime (dir)
  2074. "Return the last modtime if DIR is a directory, and nil otherwise."
  2075. (and ess-filenames-map
  2076. (file-directory-p dir)
  2077. (nth 5 (file-attributes dir))))
  2078. (defun ess-object-modtime (object)
  2079. "Return the modtime of the S object OBJECT (a string).
  2080. Searches along the search list for a file named OBJECT and returns its modtime
  2081. Returns nil if that file cannot be found, i.e., for R or any non-S language!"
  2082. (let ((path (ess-search-list))
  2083. result)
  2084. (while (and (not result) path)
  2085. (setq result (file-attributes
  2086. (concat (file-name-as-directory (car path))
  2087. object)))
  2088. (setq path (cdr path)))
  2089. (nth 5 result)))
  2090. (defun ess-modtime-gt (mod1 mod2)
  2091. "Return t if MOD1 is later than MOD2."
  2092. (and mod1
  2093. (or (> (car mod1) (car mod2))
  2094. (and (= (car mod1) (car mod2))
  2095. (> (car (cdr mod1)) (car (cdr mod2)))))))
  2096. (defun ess-get-object-list (name &optional exclude-first)
  2097. "Return a list of current S object names associated with process NAME,
  2098. using `ess-object-list' if that is non-nil.
  2099. If exclude-first is non-nil, don't return objects in first positon (.GlobalEnv)."
  2100. (or ess-object-list ;; <<- MM: this is now always(?) nil; we cache the *-modtime-alist
  2101. (with-current-buffer (process-buffer (ess-get-process name))
  2102. (ess-make-buffer-current)
  2103. (ess-write-to-dribble-buffer (format "(get-object-list %s) .." name))
  2104. (if (or (not ess-sl-modtime-alist)
  2105. (ess-process-get 'sp-for-help-changed?))
  2106. (progn (ess-write-to-dribble-buffer "--> (ess-get-modtime-list)\n")
  2107. (ess-get-modtime-list))
  2108. ;;else
  2109. (ess-write-to-dribble-buffer " using existing ess-sl-modtime-alist\n"))
  2110. (let* ((alist ess-sl-modtime-alist)
  2111. (i 2)
  2112. (n (length alist))
  2113. result)
  2114. (ess-write-to-dribble-buffer (format " (length alist) : %d\n" n))
  2115. (unless exclude-first
  2116. ;; re-read of position 1 :
  2117. (setq result (ess-extract-onames-from-alist alist 1 'force)))
  2118. (ess-write-to-dribble-buffer
  2119. (format " have re-read pos=1: -> length %d\n" (length result)))
  2120. ;; Re-read remaining directories if necessary.
  2121. (while (<= i n)
  2122. (setq result
  2123. (append result
  2124. (ess-extract-onames-from-alist alist i)))
  2125. (setq i (1+ i)))
  2126. (setq ess-object-list (delete-dups result))))))
  2127. (defun ess-get-words-from-vector (command &optional no-prompt-check wait proc)
  2128. "Evaluate the S command COMMAND, which returns a character vector.
  2129. Return the elements of the result of COMMAND as an alist of
  2130. strings. COMMAND should have a terminating newline.
  2131. NO-PROMPT-CHECK, WAIT, and PROC are passed to `ess-command'.
  2132. FILTER may be the keyword 'non-... or nil. To avoid truncation of
  2133. long vectors, wrap your command (%s) like this, or a version with
  2134. explicit options(max.print=1e6): \"local({ out <- try({%s});
  2135. print(out, max=1e6) })\n\"."
  2136. (unless proc
  2137. (inferior-ess-force))
  2138. (let* ((tbuffer (get-buffer-create
  2139. " *ess-get-words*")); initial space: disable-undo
  2140. (word-RE
  2141. (concat "\\("
  2142. "\\\\\"" "\\|" "[^\"]" ; \" or non-"-char
  2143. "\\)*"))
  2144. (full-word-regexp
  2145. (concat "\"" "\\(" word-RE "\\)"
  2146. "\""
  2147. "\\( \\|$\\)"; space or end
  2148. ))
  2149. words)
  2150. (ess-command command tbuffer 'sleep no-prompt-check wait proc)
  2151. (with-current-buffer tbuffer
  2152. (goto-char (point-min))
  2153. (while (re-search-forward full-word-regexp nil t)
  2154. (setq words (cons (buffer-substring (match-beginning 1) (match-end 1))
  2155. words))))
  2156. (ess-if-verbose-write
  2157. (if (> (length words) 5)
  2158. (format " |-> (length words)= %d\n" (length words))
  2159. (format " |-> words= '%s'\n" words)))
  2160. (reverse words)))
  2161. (defun ess-compiled-dir (dir)
  2162. "Return non-nil if DIR is an S object directory with special files.
  2163. I.e. if the filenames in DIR are not representative of the objects in DIR."
  2164. (or (file-exists-p (concat (file-name-as-directory dir) "___nonfile"))
  2165. (file-exists-p (concat (file-name-as-directory dir) "__BIGIN"))
  2166. (file-exists-p (concat (file-name-as-directory dir) "___NONFI"))))
  2167. (defun ess-object-names (obj &optional pos)
  2168. "Return alist of S object names in directory (or object) OBJ.
  2169. If OBJ is a directory name (begins with `/') returns a listing of
  2170. that dir. This may use the search list position POS if necessary.
  2171. If OBJ is an object name, returns result of the command
  2172. `inferior-ess-safe-names-command'. If POS is supplied return the
  2173. result of the command in `inferior-ess-objects-command'. If OBJ
  2174. is nil or not a directory, POS must be supplied. In all cases,
  2175. the value is an list of object names."
  2176. (cond ((and (stringp obj)
  2177. (string-match-p "ESSR" obj))
  2178. nil)
  2179. ;; FIXME: in both cases below, the same fallback "objects(POS)" is used -- merge!
  2180. ((and obj (file-accessible-directory-p obj))
  2181. ;; Check the pre-compiled object list in ess-object-name-db first
  2182. ;; FIXME: If used at all, ess-object-name-db should not only
  2183. ;; ----- be used in the directory case !!
  2184. (or (cdr-safe (assoc obj ess-object-name-db))
  2185. ;; Take a directory listing
  2186. (and ess-filenames-map
  2187. ;; first try .Data subdirectory:
  2188. ;;FIXME: move ".Data" or ``this function'' to ess-sp6-d.el etc:
  2189. (let ((dir (concat (file-name-as-directory obj) ".Data")))
  2190. (if (not (file-accessible-directory-p dir))
  2191. (setq dir obj))
  2192. (and (not (ess-compiled-dir dir))
  2193. (directory-files dir))))
  2194. ;; Get objects(pos) instead
  2195. (and (or (ess-write-to-dribble-buffer
  2196. (format "(ess-object-names ..): directory %s not used\n" obj))
  2197. t)
  2198. pos
  2199. (ess-get-words-from-vector
  2200. (format inferior-ess-objects-command pos)))))
  2201. ((and obj ;; want names(obj)
  2202. (ess-get-words-from-vector
  2203. (format inferior-ess-safe-names-command obj))))
  2204. (pos
  2205. (ess-get-words-from-vector
  2206. (format inferior-ess-objects-command pos)))))
  2207. (defun ess-slot-names (obj)
  2208. "Return alist of S4 slot names of S4 object OBJ."
  2209. (ess-get-words-from-vector (format "slotNames(%s)\n" obj)))
  2210. (defun ess-function-arguments (funname &optional proc)
  2211. "Get FUNARGS from cache or ask the process for it.
  2212. Return FUNARGS - a list with the first element being a
  2213. cons (PACKAGE_NAME . TIME_STAMP), second element is a string
  2214. giving arguments of the function as they appear in documentation,
  2215. third element is a list of arguments of all methods. If PROC is
  2216. given, it should be an ESS process. If PACKAGE_NAME is nil, and
  2217. TIME_STAMP is less recent than the time of the last user
  2218. interaction to the process, then update the entry. PACKAGE_NAME
  2219. is also nil when FUNNAME was not found, or FUNNAME is a special
  2220. name that contains :,$ or @."
  2221. (when (and funname ;; usually returned by ess--fn-name-start (might be nil)
  2222. (or proc (ess-process-live-p)))
  2223. (let* ((proc (or proc (get-process ess-local-process-name)))
  2224. (cache (or (process-get proc 'funargs-cache)
  2225. (let ((cache (make-hash-table :test 'equal)))
  2226. (process-put proc 'funargs-cache cache)
  2227. cache)))
  2228. (args (gethash funname cache))
  2229. (pack (caar args))
  2230. (ts (cdar args)))
  2231. (when (and args
  2232. (and (time-less-p ts (process-get proc 'last-eval))
  2233. (or (null pack)
  2234. (equal pack ""))))
  2235. ;; reset cache
  2236. (setq args nil))
  2237. (or args
  2238. (cadr (assoc funname (process-get proc 'funargs-pre-cache)))
  2239. (and
  2240. (not (process-get proc 'busy))
  2241. (with-current-buffer (ess-command (format ess-funargs-command
  2242. (ess-quote-special-chars funname))
  2243. nil nil nil nil proc)
  2244. (goto-char (point-min))
  2245. (when (re-search-forward "(list" nil t)
  2246. (goto-char (match-beginning 0))
  2247. (setq args (ignore-errors (eval (read (current-buffer)))))
  2248. (when args
  2249. (setcar args (cons (car args) (current-time)))))
  2250. ;; push even if nil
  2251. (puthash (substring-no-properties funname) args cache)))))))
  2252. ;;; SJE: Wed 29 Dec 2004 --- remove this function.
  2253. ;;; rmh: Wed 5 Jan 2005 --- bring it back for use on Windows
  2254. (defun ess-create-object-name-db ()
  2255. "Create a database of object names in standard S directories.
  2256. This database is saved in the file specified by
  2257. `ess-object-name-db-file', and is loaded when `ess-mode' is
  2258. loaded. It defines the variable `ess-object-name-db', which is
  2259. used for completions. Before you call this function, modify the S
  2260. search list so that it contains all the non-changing (i.e.
  2261. system) S directories. All positions of the search list except
  2262. for position 1 are searched and stored in the database. After
  2263. running this command, you should move ess-namedb.el to a
  2264. directory in the `load-path'."
  2265. (interactive)
  2266. (setq ess-object-name-db nil)
  2267. (let ((search-list (cdr (ess-search-list)))
  2268. (pos 2)
  2269. name
  2270. (buffer (get-buffer-create " *ess-db*"))
  2271. (temp-object-name-db nil))
  2272. (ess-write-to-dribble-buffer
  2273. (format "(object db): search-list=%s \n " search-list))
  2274. (while search-list
  2275. (message "Searching %s" (car search-list))
  2276. (setq temp-object-name-db (cons (cons (car search-list)
  2277. (ess-object-names nil pos))
  2278. temp-object-name-db))
  2279. (setq search-list (cdr search-list))
  2280. (ess-write-to-dribble-buffer
  2281. (format "(object db): temp-obj-name-db=%s \n pos=%s"
  2282. temp-object-name-db pos))
  2283. (setq pos (1+ pos)))
  2284. (with-current-buffer buffer
  2285. (erase-buffer)
  2286. (insert "(setq ess-object-name-db '")
  2287. (prin1 temp-object-name-db (current-buffer))
  2288. (insert ")\n")
  2289. (setq name (expand-file-name ess-object-name-db-file))
  2290. (write-region (point-min) (point-max) name)
  2291. (message "Wrote %s" name))
  2292. (kill-buffer buffer)
  2293. (setq ess-object-name-db temp-object-name-db)))
  2294. (defun ess-resynch nil
  2295. "Reread all directories/objects in variable `ess-search-list' to form completions."
  2296. (interactive)
  2297. (if (ess-make-buffer-current) nil
  2298. (error "Not an ESS process buffer"))
  2299. (setq
  2300. ess-sl-modtime-alist nil
  2301. ess-object-list nil
  2302. ess-object-name-db nil ; perhaps it would be better to reload?
  2303. )
  2304. (ess-process-put 'sp-for-help-changed? t)
  2305. ;; Action! :
  2306. (ess-get-modtime-list))
  2307. (defun ess-filename-completion ()
  2308. "Return completion only within string or comment."
  2309. (save-restriction ;; explicitly handle inferior-ess
  2310. (ignore-errors
  2311. (when (and (derived-mode-p 'inferior-ess-mode)
  2312. (> (point) (process-mark (get-buffer-process (current-buffer)))))
  2313. (narrow-to-region (process-mark (get-buffer-process (current-buffer)))
  2314. (point-max))))
  2315. (when (and (not (equal ?` (nth 3 (syntax-ppss (point)))))
  2316. (ess-inside-string-or-comment-p (point)))
  2317. (append (comint-filename-completion) '(:exclusive no)))))
  2318. (defun ess-complete-filename ()
  2319. "Do file completion only within strings."
  2320. (save-restriction ;; explicitly handle inferior-ess
  2321. (ignore-errors
  2322. (when (and (derived-mode-p 'inferior-ess-mode)
  2323. (> (point) (process-mark (get-buffer-process (current-buffer)))))
  2324. (narrow-to-region (process-mark (get-buffer-process (current-buffer)))
  2325. (point-max))))
  2326. (when (or (ess-inside-string-or-comment-p (point))) ;; usable within ess-mode as well
  2327. (comint-dynamic-complete-filename))))
  2328. (defun ess-after-pathname-p nil
  2329. ;; Heuristic: after partial pathname if it looks like we're in a
  2330. ;; string, and that string looks like a pathname. Not the best for
  2331. ;; use with unix() (or it's alias, !). Oh well.
  2332. (save-excursion
  2333. (save-match-data
  2334. (let ((opoint (point)))
  2335. (and (re-search-backward "\\(\"\\|'\\)[~/#$.a-zA-Z0-9][^ \t\n\"']*"
  2336. nil t)
  2337. (eq opoint (match-end 0)))))))
  2338. ;;*;; Functions handling the search list
  2339. (defun ess-search-list (&optional force-update)
  2340. "Return the current search list as a list of strings.
  2341. Elements which are apparently directories are expanded to full
  2342. dirnames. Don't try to use cache if FORCE-UPDATE is non-nil. Is
  2343. *NOT* used by \\[ess-execute-search], but by \\[ess-resynch],
  2344. \\[ess-get-object-list], \\[ess-get-modtime-list],
  2345. \\[ess-execute-objects], \\[ess-object-modtime],
  2346. \\[ess-create-object-name-db], and (indirectly) by
  2347. \\[ess-get-help-files-list]."
  2348. (with-current-buffer
  2349. (ess-get-process-buffer ess-current-process-name);to get *its* local vars
  2350. (let ((result nil)
  2351. (slist (ess-process-get 'search-list))
  2352. (tramp-mode nil)) ;; hack for bogus file-directory-p below
  2353. (if (and slist
  2354. (not force-update)
  2355. (not (ess-process-get 'sp-for-help-changed?)))
  2356. slist
  2357. ;; else, re-compute:
  2358. (ess-write-to-dribble-buffer " (ess-search-list ... ) ")
  2359. (let ((tbuffer (get-buffer-create " *search-list*"))
  2360. (homedir default-directory)
  2361. (my-search-cmd inferior-ess-search-list-command); from ess-buffer
  2362. elt)
  2363. (ess-command my-search-cmd tbuffer 0.05); <- sleep for dde only; does (erase-buffer)
  2364. (with-current-buffer tbuffer
  2365. ;; guaranteed by the initial space in its name: (buffer-disable-undo)
  2366. (goto-char (point-min))
  2367. (ess-write-to-dribble-buffer
  2368. (format "after '%s', point-max=%d\n" my-search-cmd (point-max)))
  2369. (while (re-search-forward "\"\\([^\"]*\\)\"" nil t)
  2370. (setq elt (buffer-substring (match-beginning 1) (match-end 1)))
  2371. ;;Dbg: (ess-write-to-dribble-buffer (format " .. elt= %s \t" elt))
  2372. (if (and (string-match "^[^/]" elt)
  2373. (file-directory-p (concat homedir elt)))
  2374. (progn
  2375. ;;Dbg: (ess-write-to-dribble-buffer "*IS* directory\n")
  2376. (setq elt (concat homedir elt)))
  2377. ;;else
  2378. ;;dbg
  2379. ;;- (ess-write-to-dribble-buffer "not dir.\n")
  2380. )
  2381. (setq result (append result (list elt))))
  2382. (kill-buffer tbuffer)))
  2383. result))))
  2384. ;;; ess-sl-modtime-alist is a list with elements as follows:
  2385. ;;; * key (directory or object name)
  2386. ;;; * modtime (list of 2 integers)
  2387. ;;; * name, name ... (accessible objects in search list posn labeled by key)
  2388. ;;; It is a buffer-local variable (belonging to e.g. *R*, *S+6*, .. etc)
  2389. ;;; and has the same number of elements and is in the same order as the
  2390. ;;; S search list
  2391. (defun ess-get-modtime-list (&optional cache-var-name exclude-first)
  2392. "Record directories in the search list, and the objects in those directories.
  2393. The result is stored in CACHE-VAR-NAME. If nil, CACHE-VAR-NAME
  2394. defaults to `ess-sl-modtime-alist'. If EXCLUDE-FIRST is non-nil
  2395. don't recompile first object in the search list."
  2396. ;; Operation applies to process of current buffer
  2397. (let* ((searchlist (if exclude-first
  2398. (cdr (ess-search-list))
  2399. (ess-search-list)))
  2400. (index (if exclude-first 2 1))
  2401. (cache-name (or cache-var-name 'ess-sl-modtime-alist))
  2402. pack newalist)
  2403. (while searchlist
  2404. (setq
  2405. pack (car searchlist)
  2406. newalist (append newalist
  2407. (list (or (assoc pack (symbol-value cache-name))
  2408. (append
  2409. (list pack (ess-dir-modtime pack))
  2410. (prog2
  2411. (message "Forming completions for %s..." pack)
  2412. (ess-object-names pack index)
  2413. (message "Forming completions for %s...done" pack))))))
  2414. index (1+ index)
  2415. searchlist (cdr searchlist)))
  2416. ;;DBG:
  2417. (ess-write-to-dribble-buffer
  2418. (format "(%s): created new alist of length %d\n"
  2419. cache-var-name (length newalist)))
  2420. (set cache-name newalist)))
  2421. (defun ess-search-path-tracker (str)
  2422. "Check if input STR changed the search path.
  2423. This function monitors user input to the inferior ESS process so
  2424. that Emacs can keep the process variable 'search-list' up to
  2425. date. `ess-completing-read' in \\[ess-read-object-name] uses this
  2426. list indirectly when it prompts for help or for an object to
  2427. dump. From ESS 12.09 this is not necessary anymore, as the search
  2428. path is checked on idle time. It is kept for robustness and
  2429. backward compatibility only."
  2430. (when ess-change-sp-regexp
  2431. (if (string-match ess-change-sp-regexp str)
  2432. (ess-process-put 'sp-for-help-changed? t))))
  2433. ;;; Miscellaneous routines
  2434. ;;;*;;; Routines for reading object names
  2435. (defun ess-read-object-name (p-string)
  2436. "Read an object name from the minibuffer with completion, and return it.
  2437. P-STRING is the prompt string."
  2438. (let* ((default (ess-read-object-name-dump))
  2439. (object-list (ess-get-object-list ess-local-process-name))
  2440. (spec (ess-completing-read p-string object-list nil nil nil nil default)))
  2441. (list (cond
  2442. ((string= spec "") default)
  2443. (t spec)))))
  2444. (defun ess-read-object-name-default ()
  2445. "Return the object name at point, or nil if none."
  2446. (ignore-errors
  2447. (save-excursion
  2448. ;; The following line circumvents an 18.57 bug in following-char
  2449. (if (eobp) (backward-char 1)) ; Hopefully buffer is not empty!
  2450. ;; Get onto a symbol
  2451. (catch 'nosym ; bail out if there's no symbol at all before point
  2452. (while (let ((sc (char-syntax (following-char))))
  2453. (not (or (= sc ?w) (= sc ?_))))
  2454. (if (bobp) (throw 'nosym nil) (backward-char 1))))
  2455. (let*
  2456. ((end (progn (forward-sexp 1) (point)))
  2457. (beg (progn (backward-sexp 1) (point))))
  2458. (buffer-substring-no-properties beg end)))))
  2459. (defun ess-read-object-name-dump ()
  2460. "Return the object name at point, or \"Temporary\" if none."
  2461. (ignore-errors
  2462. (save-excursion
  2463. ;; Get onto a symbol
  2464. (catch 'nosym ; bail out if there's no symbol at all before point
  2465. (while (/= (char-syntax (following-char)) ?w)
  2466. (if (bobp) (throw 'nosym nil) (backward-char 1)))
  2467. (let*
  2468. ((end (progn (forward-sexp 1) (point)))
  2469. (beg (progn (backward-sexp 1) (point)))
  2470. (object-name (buffer-substring beg end)))
  2471. (or object-name "Temporary"))))))
  2472. ;;;; start of ess-smart-operators
  2473. ;;;; inspired by slime repl shortcuts
  2474. (defvar ess--handy-history nil)
  2475. (defun ess-handy-commands ()
  2476. "Request and execute a command from `ess-handy-commands' list."
  2477. (interactive)
  2478. (let* ((commands (or ess--local-handy-commands
  2479. ess-handy-commands))
  2480. (hist (and (assoc (car ess--handy-history)
  2481. commands)
  2482. (car ess--handy-history))))
  2483. (call-interactively
  2484. (cdr (assoc (ess-completing-read "Execute"
  2485. (sort (mapcar 'car commands)
  2486. 'string-lessp)
  2487. nil t nil 'ess--handy-history hist)
  2488. commands)))))
  2489. (defun ess-smart-comma ()
  2490. "If comma is invoked at the process marker of an ESS inferior
  2491. buffer, request and execute a command from `ess-handy-commands'
  2492. list."
  2493. (interactive)
  2494. (let ((proc (get-buffer-process (current-buffer))))
  2495. (if (and proc
  2496. (eq (point) (marker-position (process-mark proc))))
  2497. (ess-handy-commands)
  2498. (if ess-smart-operators
  2499. (progn
  2500. (delete-horizontal-space)
  2501. (insert ", ")
  2502. (unless (derived-mode-p 'inferior-ess-mode)
  2503. (indent-according-to-mode)))
  2504. (insert ",")))))
  2505. ; directories
  2506. (defun ess-set-working-directory (path &optional no-error)
  2507. "Set the current working to PATH for the ESS buffer and iESS process.
  2508. NO-ERROR prevents errors when this has not been implemented for
  2509. `ess-dialect'."
  2510. (interactive "DChange working directory to: ")
  2511. (if ess-setwd-command
  2512. (let* ((remote (file-remote-p path))
  2513. (path (if remote
  2514. (progn
  2515. (require 'tramp-sh)
  2516. (tramp-sh-handle-expand-file-name path))
  2517. path))
  2518. (lpath (if remote
  2519. (with-parsed-tramp-file-name path v v-localname)
  2520. path)))
  2521. (ess-eval-linewise (format ess-setwd-command lpath))
  2522. ;; use set instead of setq to take effect even when let bound
  2523. (set 'default-directory (file-name-as-directory path)))
  2524. (unless no-error
  2525. (error "Not implemented for dialect %s" ess-dialect))))
  2526. (defalias 'ess-change-directory 'ess-set-working-directory)
  2527. (define-obsolete-function-alias
  2528. 'ess-use-dir 'ess-set-working-directory "ESS 18.10")
  2529. (defun ess-use-this-dir (&rest _ignore)
  2530. "Set the current process directory to the directory of this file.
  2531. `default-directory' is used as a fallback."
  2532. (interactive)
  2533. (let ((dir (if buffer-file-name
  2534. (file-name-directory buffer-file-name)
  2535. default-directory)))
  2536. (ess-set-working-directory (abbreviate-file-name dir))))
  2537. (defun ess-get-working-directory (&optional no-error)
  2538. "Retrieve the current working directory from the current ess process."
  2539. (if ess-getwd-command
  2540. (abbreviate-file-name (car (ess-get-words-from-vector ess-getwd-command)))
  2541. (unless no-error
  2542. (error "Not implemented for dialect %s" ess-dialect))))
  2543. (defun ess-synchronize-dirs ()
  2544. "Set Emacs' current directory to be the same as the subprocess directory.
  2545. To be used in `ess-idle-timer-functions'."
  2546. (when (and ess-can-eval-in-background
  2547. ess-getwd-command
  2548. (inferior-ess-available-p))
  2549. (ess-when-new-input last-sync-dirs
  2550. (ess-if-verbose-write "\n(ess-synchronize-dirs)\n")
  2551. (setq default-directory
  2552. (car (ess-get-words-from-vector ess-getwd-command)))
  2553. default-directory)))
  2554. (defun ess-dirs ()
  2555. "Set Emacs' current directory to be the same as the *R* process."
  2556. ;; Note: This function is not necessary anymore. The Emacs
  2557. ;; default-directory and subprocess working directory are
  2558. ;; synchronized automatically.
  2559. (interactive)
  2560. (let ((dir (car (ess-get-words-from-vector "getwd()\n"))))
  2561. (message "(ESS / default) directory: %s" dir)
  2562. (setq default-directory (file-name-as-directory dir))))
  2563. ;; search path
  2564. (defun ess--mark-search-list-as-changed ()
  2565. "Internal. Mark all the search-list related variables as changed."
  2566. ;; other guys might track their own
  2567. (ess-process-put 'sp-for-help-changed? t)
  2568. (ess-process-put 'sp-for-ac-changed? t))
  2569. (defun ess-cache-search-list ()
  2570. "To be used in `ess-idle-timer-functions', to set search path related variables."
  2571. (when (and ess-can-eval-in-background
  2572. inferior-ess-search-list-command)
  2573. (ess-when-new-input last-cache-search-list
  2574. (let ((path (ess-search-list 'force))
  2575. (old-path (process-get *proc* 'search-list)))
  2576. (when (not (equal path old-path))
  2577. (process-put *proc* 'search-list path)
  2578. (ess--mark-search-list-as-changed)
  2579. path)))))
  2580. ;;*;; Temporary buffer handling
  2581. (defun ess-display-temp-buffer (buff)
  2582. "Display the buffer BUFF.
  2583. Uses `temp-buffer-show-function' and respects
  2584. `ess-display-buffer-reuse-frames'."
  2585. (if (fboundp temp-buffer-show-function)
  2586. (funcall temp-buffer-show-function buff))
  2587. (display-buffer buff '(display-buffer-reuse-window) ess-display-buffer-reuse-frames))
  2588. (defun ess--inject-code-from-file (file &optional chunked)
  2589. "Load code from FILE into process.
  2590. If CHUNKED is non-nil, split the file by separator (must be at
  2591. bol) and load each chunk separately."
  2592. ;; This is different from ess-load-file as it works by directly loading the
  2593. ;; string into the process and thus works on remotes.
  2594. (let ((proc-name ess-local-process-name)
  2595. (dialect ess-dialect)
  2596. (send-1 (lambda (str)
  2597. (if (string= ess-dialect "R")
  2598. ;; avoid detection of intermediate prompts
  2599. (ess-command (concat "{" str "}\n"))
  2600. (ess-command str)))))
  2601. (with-temp-buffer
  2602. (setq ess-local-process-name proc-name
  2603. ess-dialect dialect)
  2604. (insert-file-contents-literally file)
  2605. (if chunked
  2606. (let ((beg (point-min)))
  2607. (goto-char beg)
  2608. (while (re-search-forward "^ " nil t)
  2609. (funcall send-1 (buffer-substring beg (point)))
  2610. (setq beg (point)))
  2611. (funcall send-1 (buffer-substring (point) (point-max))))
  2612. (funcall send-1 (buffer-string))))))
  2613. (defun ess-check-modifications nil
  2614. "Check whether loading this file would overwrite some ESS objects
  2615. which have been modified more recently than this file, and confirm
  2616. if this is the case."
  2617. ;; FIXME: this should really cycle through all top-level assignments in
  2618. ;; the buffer
  2619. ;;VS[02-04-2012|ESS 12.03]: this is sooo ugly
  2620. (when (> (length ess-change-sp-regexp) 0)
  2621. (and (buffer-file-name) ess-filenames-map
  2622. (let ((sourcemod (nth 5 (file-attributes (buffer-file-name))))
  2623. (objname))
  2624. (save-excursion
  2625. (goto-char (point-min))
  2626. ;; Get name of assigned object, if we can find it
  2627. (setq objname
  2628. (and
  2629. (re-search-forward
  2630. "^\\s *\"?\\(\\(\\sw\\|\\s_\\)+\\)\"?\\s *[<_]"
  2631. nil
  2632. t)
  2633. (buffer-substring (match-beginning 1)
  2634. (match-end 1)))))
  2635. (and
  2636. sourcemod ; the file may have been deleted
  2637. objname ; may not have been able to
  2638. ; find name
  2639. (ess-modtime-gt (ess-object-modtime objname) sourcemod)
  2640. (not (y-or-n-p
  2641. (format
  2642. "The ESS object %s is newer than this file. Continue? "
  2643. objname)))
  2644. (error "Aborted"))))))
  2645. (define-obsolete-function-alias 'ess-check-source #'ess-save-file "ESS 19.04")
  2646. (defun ess-save-file (file)
  2647. "If FILE (a string) has an unsaved buffer, offer to save it.
  2648. Return t if the buffer existed and was modified, but was not
  2649. saved. If `ess-save-silently' is non-nil, the buffer is
  2650. saved without offering."
  2651. (when-let ((buff (find-buffer-visiting file)))
  2652. (when (and (buffer-modified-p buff)
  2653. (or (eql ess-save-silently t)
  2654. (and (eql ess-save-silently 'auto)
  2655. (or (not compilation-ask-about-save)
  2656. (bound-and-true-p
  2657. ;; Only added in Emacs 26.1
  2658. auto-save-visited-mode)))
  2659. (y-or-n-p
  2660. (format "Buffer %s is modified. Save? "
  2661. (buffer-name buff)))))
  2662. (with-current-buffer buff
  2663. (save-buffer)))
  2664. (buffer-modified-p buff)))
  2665. ;;*;; Error messages
  2666. (defun ess-parse-errors (&optional showerr _reset)
  2667. "Jump to error in last loaded ESS source file.
  2668. With prefix argument SHOWERR, only show the errors ESS reported. RESET
  2669. is for compatibility with `next-error' and is ignored."
  2670. (interactive "P")
  2671. (ess-make-buffer-current)
  2672. (let ((errbuff (get-buffer ess-error-buffer-name)))
  2673. (when (not errbuff)
  2674. (error "You need to do a load first!"))
  2675. (set-buffer errbuff)
  2676. (goto-char (point-max))
  2677. ;; FIXME: R does not give "useful" error messages by default. We
  2678. ;; could try to use a more useful one, via
  2679. ;; options(error=essErrorHandler)
  2680. (cond ((re-search-backward ess-error-regexp nil t)
  2681. (let* ((filename (buffer-substring (match-beginning 3) (match-end 3)))
  2682. (fbuffer (get-file-buffer filename))
  2683. (linenum
  2684. (string-to-number
  2685. (buffer-substring (match-beginning 2) (match-end 2))))
  2686. (errmess (buffer-substring (match-beginning 1) (match-end 1))))
  2687. (if showerr
  2688. (ess-display-temp-buffer errbuff)
  2689. (if fbuffer nil
  2690. (setq fbuffer (find-file-noselect filename))
  2691. (with-current-buffer fbuffer
  2692. ;; TODO: ess-mode is surely wrong here, but I don't
  2693. ;; think we need this whole function anymore?
  2694. (when (fboundp 'ess-mode)
  2695. (ess-mode))))
  2696. (pop-to-buffer fbuffer)
  2697. (ess-goto-line linenum))
  2698. (princ errmess t)))
  2699. (t
  2700. (message "Not a syntax error.")
  2701. (ess-display-temp-buffer errbuff)))))
  2702. (defun ess-error (msg)
  2703. "Something bad has happened.
  2704. Display the S buffer, and cause an error displaying MSG."
  2705. (declare (obsolete error "ESS 18.10"))
  2706. (display-buffer (process-buffer (get-process ess-local-process-name)))
  2707. (error msg))
  2708. (provide 'ess-inf)
  2709. ;;; ess-inf.el ends here