branch: externals/ess
commit cbebb1f655a640e6db17055b0f31fabb19c24b65
Merge: 19724bbe35 190ad9d0fb
Author: Lionel Henry <lionel....@gmail.com>
Commit: GitHub <nore...@github.com>
Merge pull request #1244 from emacs-ess/proc-background-eval-guard
Disable background evals when process init failed
---
doc/newfeat.texi | 5 +++
lisp/ess-inf.el | 50 ++++++++++++++++++++------
lisp/ess-julia.el | 2 +-
lisp/ess-r-completion.el | 92 ++++++++++++++++++++++--------------------------
lisp/ess-r-mode.el | 5 +--
test/ess-test-r.el | 7 ++++
6 files changed, 98 insertions(+), 63 deletions(-)
diff --git a/doc/newfeat.texi b/doc/newfeat.texi
index 54315c7580..e483d01d40 100644
--- a/doc/newfeat.texi
+++ b/doc/newfeat.texi
@@ -4,6 +4,11 @@
Changes and New Features in 19.04 (unreleased):
@itemize @bullet
+@item ESS[R]: Background commands can now be disabled by process instad of
globally.
+For instance when a process has failed to initialize properly,
+background evals are disabled for that particular process to avoid
+cascading errors. Other processes may still use background commands.
+
@item ESS[R]: ESSR commands are now more robust when ESSR is
not in scope. This can happen when using @code{browser()} in
an environment that doesn't inherit from the search path.
diff --git a/lisp/ess-inf.el b/lisp/ess-inf.el
index 4309024821..b8cafe807f 100644
--- a/lisp/ess-inf.el
+++ b/lisp/ess-inf.el
@@ -360,8 +360,7 @@ defined. If no project directory has been found, use
(defun inferior-ess-available-p (&optional proc)
"Return non-nil if PROC is not busy."
- (when-let ((proc (or proc (and ess-local-process-name
- (get-process ess-local-process-name)))))
+ (when-let ((proc (or proc (ess-get-current-process))))
(unless (process-get proc 'busy)
(or (ess-debug-active-p proc) ; don't send empty lines in debugger
(when-let ((last-check (process-get proc 'last-availability-check)))
@@ -755,10 +754,8 @@ Returns the name of the process, or nil if the current
buffer has none."
"Check if the local ess process is alive.
Return nil if current buffer has no associated process, or
process was killed. PROC defaults to `ess-local-process-name'"
- (and (or proc ess-local-process-name)
- (let ((proc (or proc (get-process ess-local-process-name))))
- (and (processp proc)
- (process-live-p proc)))))
+ (when-let ((proc (or proc (ess-get-current-process))))
+ (process-live-p proc)))
(defun ess-process-get (propname &optional proc)
"Return the variable PROPNAME (symbol) of the current ESS process.
@@ -910,12 +907,19 @@ it was successfully forced, throws an error otherwise."
(interactive)
(ess-force-buffer-current "Process to use: " 'force nil 'ask-if-1))
-(defun ess-get-next-available-process (&optional dialect ignore-busy)
+(defun ess-get-current-process ()
+ (when ess-local-process-name
+ (get-process ess-local-process-name)))
+
+(defun ess-get-next-available-process (&optional dialect ignore-busy
background)
"Return first available (aka not busy) process of dialect DIALECT.
DIALECT defaults to the local value of ess-dialect. Return nil if
-no such process has been found."
+no such process has been found. If BACKGROUND is non-nil, only
+processes that are allowed to evaluate in the background are
+matched."
(setq dialect (or dialect ess-dialect))
- (when dialect
+ (when (and dialect (or (not background)
+ ess-can-eval-in-background))
(let (proc)
(catch 'found
(dolist (p (cons ess-local-process-name
@@ -926,10 +930,23 @@ no such process has been found."
(process-live-p proc)
(equal dialect
(buffer-local-value 'ess-dialect (process-buffer
proc)))
+ ;; Check that we can evaluate in background
+ ;; before checking for availability to
+ ;; avoid issues with newline handshakes
+ (or (not background)
+ (ess-can-eval-in-background proc))
(or ignore-busy
(inferior-ess-available-p proc)))
(throw 'found proc))))))))
+(defun ess-get-next-available-bg-process (&optional proc dialect ignore-busy)
+ "Returns first avaiable process only if background evaluations are allowed.
+Same as `ess-get-next-available-process' but checks for
+`ess-can-eval-in-background'."
+ (if proc
+ (ess-can-eval-in-background proc)
+ (ess-get-next-available-process dialect ignore-busy 'background)))
+
;;*;;; Commands for switching to the process buffer
@@ -2181,6 +2198,17 @@ If in the output field, goes to the beginning of
previous input."
(inferior-ess--get-old-input:regexp)
(inferior-ess--get-old-input:field)))
+(defun ess-can-eval-in-background (&optional proc)
+ "Can the current process be used for background commands.
+Inspects the `ess-can-eval-in-background' variable as well as the
+`bg-eval-disabled' property of PROC or of the current process, if
+any. This makes it possible to disable background evals for a
+specific process, for instance in case it was not initialized
+properly."
+ (when ess-can-eval-in-background
+ (when-let ((proc (or proc (ess-get-current-process))))
+ (not (process-get proc 'bg-eval-disabled)))))
+
;;;*;;; Hot key commands
@@ -3000,7 +3028,7 @@ NO-ERROR prevents errors when this has not been
implemented for
(defun ess-synchronize-dirs ()
"Set Emacs' current directory to be the same as the subprocess directory.
To be used in `ess-idle-timer-functions'."
- (when (and ess-can-eval-in-background
+ (when (and (ess-can-eval-in-background)
ess-getwd-command
(inferior-ess-available-p))
(ess-when-new-input last-sync-dirs
@@ -3040,7 +3068,7 @@ path, and can be a remote path"
(defun ess-cache-search-list ()
"To be used in `ess-idle-timer-functions', to set search path related
variables."
- (when (and ess-can-eval-in-background
+ (when (and (ess-can-eval-in-background)
inferior-ess-search-list-command)
(ess-when-new-input last-cache-search-list
(let ((path (ess-search-list 'force))
diff --git a/lisp/ess-julia.el b/lisp/ess-julia.el
index a6d31a6ab8..92a55f3291 100644
--- a/lisp/ess-julia.el
+++ b/lisp/ess-julia.el
@@ -262,7 +262,7 @@ objects from that MODULE."
"Return the doc string, or nil.
If an ESS process is not associated with the buffer, do not try
to look up any doc strings. Honors `eldoc-echo-area-use-multiline-p'."
- (when (and ess-can-eval-in-background
+ (when (and (ess-can-eval-in-background)
(ess-process-live-p)
(not (ess-process-get 'busy)))
(let ((funname (or (and ess-eldoc-show-on-symbol ;; aggressive completion
diff --git a/lisp/ess-r-completion.el b/lisp/ess-r-completion.el
index 6ba5133e82..da7c7abe6a 100644
--- a/lisp/ess-r-completion.el
+++ b/lisp/ess-r-completion.el
@@ -53,37 +53,36 @@
"Return the doc string, or nil.
If an ESS process is not associated with the buffer, do not try
to look up any doc strings."
- (when (and eldoc-mode ess-can-eval-in-background)
- (let* ((proc (ess-get-next-available-process))
- (funname (and proc (or (and ess-eldoc-show-on-symbol ;; Aggressive
completion
- (thing-at-point 'symbol))
- (car (ess--fn-name-start))))))
- (when funname
- (let* ((args (ess-function-arguments funname proc))
- (bargs (cadr args))
- (doc (mapconcat (lambda (el)
- (if (equal (car el) "...")
- "..."
- (concat (car el) "=" (cdr el))))
- bargs ", "))
- (margs (nth 2 args))
- (W (- (window-width (minibuffer-window)) (+ 4 (length
funname))))
- (multiline (eq t eldoc-echo-area-use-multiline-p))
- doc1)
- (when doc
- (setq doc (ess-eldoc-docstring-format funname doc (not multiline)))
- (when (or multiline (and margs (< (length doc1) W)))
- (setq doc1 (concat doc (propertize " || " 'face
font-lock-function-name-face)))
- (while (and margs (< (length doc1) W))
- (let ((head (pop margs)))
- (unless (assoc head bargs)
- (setq doc doc1
- doc1 (concat doc1 head "=, ")))))
- (when (equal (substring doc -2) ", ")
- (setq doc (substring doc 0 -2)))
- (when (and margs (< (length doc) W))
- (setq doc (concat doc " {--}"))))
- doc))))))
+ (when eldoc-mode
+ (when-let ((proc (ess-get-next-available-bg-process))
+ (funname (or (and ess-eldoc-show-on-symbol ;; Aggressive
completion
+ (thing-at-point 'symbol))
+ (car (ess--fn-name-start)))))
+ (let* ((args (ess-function-arguments funname proc))
+ (bargs (cadr args))
+ (doc (mapconcat (lambda (el)
+ (if (equal (car el) "...")
+ "..."
+ (concat (car el) "=" (cdr el))))
+ bargs ", "))
+ (margs (nth 2 args))
+ (W (- (window-width (minibuffer-window)) (+ 4 (length funname))))
+ (multiline (eq t eldoc-echo-area-use-multiline-p))
+ doc1)
+ (when doc
+ (setq doc (ess-eldoc-docstring-format funname doc (not multiline)))
+ (when (or multiline (and margs (< (length doc1) W)))
+ (setq doc1 (concat doc (propertize " || " 'face
font-lock-function-name-face)))
+ (while (and margs (< (length doc1) W))
+ (let ((head (pop margs)))
+ (unless (assoc head bargs)
+ (setq doc doc1
+ doc1 (concat doc1 head "=, ")))))
+ (when (equal (substring doc -2) ", ")
+ (setq doc (substring doc 0 -2)))
+ (when (and margs (< (length doc) W))
+ (setq doc (concat doc " {--}"))))
+ doc)))))
(defun ess-eldoc-docstring-format (funname doc &optional truncate)
(save-match-data
@@ -325,7 +324,7 @@ To be used instead of ESS' completion engine for R versions
>= 2.7.0."
(defun ess-r-get-object-help-string (sym)
"Help string for ac."
- (let ((proc (ess-get-next-available-process)))
+ (let ((proc (ess-get-next-available-bg-process)))
(if (null proc)
"No free ESS process found"
(let ((buf (get-buffer-create " *ess-command-output*")))
@@ -342,7 +341,7 @@ To be used instead of ESS' completion engine for R versions
>= 2.7.0."
(defun ess-r-get-arg-help-string (sym &optional proc)
"Help string for ac."
(setq sym (replace-regexp-in-string " *= *\\'" "" sym))
- (let ((proc (or proc (ess-get-next-available-process))))
+ (let ((proc (ess-get-next-available-bg-process proc)))
(if (null proc)
"No free ESS process found"
(let ((fun (car ess--fn-name-start-cache)))
@@ -364,11 +363,9 @@ To be used instead of ESS' completion engine for R
versions >= 2.7.0."
(let ((start (ess-symbol-start)))
(when start
(buffer-substring-no-properties start (point))))))
- (candidates (when ess-can-eval-in-background
- (let ((proc (ess-get-next-available-process)))
- (when proc
- (with-current-buffer (process-buffer proc)
- (all-completions arg (ess--get-cached-completions
arg)))))))
+ (candidates (when-let ((proc (ess-get-next-available-bg-process)))
+ (with-current-buffer (process-buffer proc)
+ (all-completions arg (ess--get-cached-completions arg)))))
(doc-buffer (company-doc-buffer (ess-r-get-object-help-string arg)))))
(defun company-R-args (command &optional arg &rest ignored)
@@ -383,21 +380,18 @@ To be used instead of ESS' completion engine for R
versions >= 2.7.0."
(cons prefix (>= (length prefix)
ess-company-arg-prefix-length))
prefix))))))
- (candidates (when ess-can-eval-in-background
- (let* ((proc (ess-get-next-available-process))
- (args (delete "..." (nth 2 (ess-function-arguments
+ (candidates (when-let ((proc (ess-get-next-available-bg-process)))
+ (let* ((args (delete "..." (nth 2 (ess-function-arguments
(car
ess--fn-name-start-cache) proc))))
(args (mapcar (lambda (a) (concat a
ess-R-argument-suffix))
args)))
(all-completions arg args))))
;; Displaying help for the argument in the echo area is disabled
;; by default for performance reasons. It causes delays or hangs (#1062).
- (meta (when (and ess-can-eval-in-background
- (bound-and-true-p ess-r--company-meta))
- (let ((proc (ess-get-next-available-process)))
- (when (and proc
- (with-current-buffer (process-buffer proc)
- (not (file-remote-p default-directory))))
+ (meta (when (bound-and-true-p ess-r--company-meta)
+ (when-let ((proc (ess-get-next-available-bg-process)))
+ (when (with-current-buffer (process-buffer proc)
+ (not (file-remote-p default-directory)))
;; fixme: ideally meta should be fetched with args
(let ((doc (ess-r-get-arg-help-string arg proc)))
(replace-regexp-in-string "^ +\\| +$" ""
@@ -414,7 +408,7 @@ To be used instead of ESS' completion engine for R versions
>= 2.7.0."
'("library" "require"))
(let ((start (ess-symbol-start)))
(and start (buffer-substring start (point))))))
- (candidates (when ess-can-eval-in-background
+ (candidates (when (ess-can-eval-in-background)
(all-completions arg (ess-installed-packages))))
(annotation "<pkg>")
(duplicates nil)
@@ -425,7 +419,7 @@ To be used instead of ESS' completion engine for R versions
>= 2.7.0."
(defun ess-r-package-completion ()
"Return installed packages if in a call to library or require.
Return format suitable for `completion-at-point-functions'."
- (when (and ess-can-eval-in-background
+ (when (and (ess-can-eval-in-background)
(member (car (ess--fn-name-start))
'("library" "require")))
(list (ess-symbol-start)
diff --git a/lisp/ess-r-mode.el b/lisp/ess-r-mode.el
index 6a638328b4..704641b9dc 100644
--- a/lisp/ess-r-mode.el
+++ b/lisp/ess-r-mode.el
@@ -669,10 +669,11 @@ Executed in process buffer."
(run-hooks 'ess-r-post-run-hook)
(ess-wait-for-process))
-;; TODO: Disable `ess-can-eval-in-background' in the process that
-;; failed to start to prevent cascading errors
(defun ess-r--init-error-handler (&optional err)
(ess-write-to-dribble-buffer "Failed to start ESSR\n")
+ (when-let ((proc (and ess-local-process-name
+ (get-process ess-local-process-name))))
+ (process-put proc 'bg-eval-disabled t))
(let ((msgs `("ESSR failed to start, please call `ess-r-initialize' to
recover"
,@(when err
(concat "Caused by error: " (error-message-string err))))))
diff --git a/test/ess-test-r.el b/test/ess-test-r.el
index cb5896c0a3..c3b1194e92 100644
--- a/test/ess-test-r.el
+++ b/test/ess-test-r.el
@@ -903,6 +903,13 @@
https://github.com/emacs-ess/ESS/issues/725#issuecomment-431781558";
(should (file-exists-p essr-path))
(ess--essr-load-or-throw-error remote-file-path
#'ess-r--fetch-ESSR-remote)))
+(ert-deftest ess-r-failed-init-disable-bg-eval-test ()
+ (with-r-running nil
+ (should-error (ess-r--init-error-handler))
+ (should (not (ess-can-eval-in-background)))
+ (let ((proc (ess-get-current-process)))
+ (should (and proc (not (eq (ess-get-next-available-bg-process)
proc)))))))
+
(provide 'ess-test-r)
