3466 lines
146 KiB
EmacsLisp
3466 lines
146 KiB
EmacsLisp
|
;;; ess-inf.el --- Support for running S as an inferior Emacs process
|
|||
|
|
|||
|
;; Copyright (C) 1989-1994 Bates, Kademan, Ritter and Smith
|
|||
|
;; Copyright (C) 1997-1999 A.J. Rossini <rossini@u.washington.edu>,
|
|||
|
;; Martin Maechler <maechler@stat.math.ethz.ch>.
|
|||
|
;; Copyright (C) 2000--2010 A.J. Rossini, Richard M. Heiberger, Martin
|
|||
|
;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
|
|||
|
;; Copyright (C) 2011--2012 A.J. Rossini, Richard M. Heiberger, Martin Maechler,
|
|||
|
;; Kurt Hornik, Rodney Sparapani, Stephen Eglen and Vitalie Spinu.
|
|||
|
|
|||
|
;; Author: David Smith <dsmith@stats.adelaide.edu.au>
|
|||
|
;; Created: 7 Jan 1994
|
|||
|
;; Maintainer: ESS-core <ESS-core@r-project.org>
|
|||
|
|
|||
|
;; This file is part of ESS
|
|||
|
|
|||
|
;; This file is free software; you can redistribute it and/or modify
|
|||
|
;; it under the terms of the GNU General Public License as published by
|
|||
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|||
|
;; any later version.
|
|||
|
|
|||
|
;; This file is distributed in the hope that it will be useful,
|
|||
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|||
|
;; GNU General Public License for more details.
|
|||
|
|
|||
|
;; A copy of the GNU General Public License is available at
|
|||
|
;; http://www.r-project.org/Licenses/
|
|||
|
|
|||
|
;;; Commentary:
|
|||
|
|
|||
|
;; Code for handling running ESS processes.
|
|||
|
|
|||
|
;;; Code:
|
|||
|
|
|||
|
; Requires and autoloads
|
|||
|
|
|||
|
;;*;; Requires
|
|||
|
|
|||
|
;; Byte-compiler, SHUT-UP!
|
|||
|
(eval-when-compile
|
|||
|
(require 'ess-utils)
|
|||
|
(require 'tramp))
|
|||
|
|
|||
|
(unless (featurep 'xemacs)
|
|||
|
(require 'newcomment nil t))
|
|||
|
(require 'comint)
|
|||
|
(require 'overlay)
|
|||
|
(require 'compile)
|
|||
|
|
|||
|
;;; VS: These autoloads are not needed. See coments in ess-mode.el.
|
|||
|
;;*;; Autoloads
|
|||
|
;; (autoload 'ess-parse-errors "ess-mode" "(autoload).")
|
|||
|
;; (autoload 'ess-dump-object-into-edit-buffer "ess-mode" "(autoload).")
|
|||
|
;; (autoload 'ess-beginning-of-function "ess-mode" "(autoload).")
|
|||
|
;; (autoload 'ess-end-of-function "ess-mode" "(autoload).")
|
|||
|
;; (autoload 'ess-display-help-on-object "ess-help" "(autoload).")
|
|||
|
|
|||
|
;; (autoload 'ess-extract-word-name "ess-utils" "(autoload).")
|
|||
|
;; (autoload 'ess-uniq-list "ess-utils" "(autoload).")
|
|||
|
|
|||
|
;; (autoload 'ess-transcript-send-command-and-move "ess-trns" "(autoload).")
|
|||
|
|
|||
|
;; (autoload 'ess-R-complete-object-name "ess-r-d" "(autoload).")
|
|||
|
|
|||
|
(autoload 'ess-eval-region-ddeclient "ess-dde" "(autoload).")
|
|||
|
(autoload 'ess-eval-linewise-ddeclient "ess-dde" "(autoload).")
|
|||
|
(autoload 'ess-load-file-ddeclient "ess-dde" "(autoload).")
|
|||
|
(autoload 'ess-command-ddeclient "ess-dde" "(autoload).")
|
|||
|
|
|||
|
(autoload 'tramp-tramp-file-p "tramp" "(autoload).")
|
|||
|
(autoload 'tramp-file-name-localname "tramp" "(autoload).")
|
|||
|
(autoload 'tramp-dissect-file-name "tramp" "(autoload).")
|
|||
|
|
|||
|
;; not really needed as tracebug and developer are loaded in r-d.el
|
|||
|
(autoload 'ess-tracebug-send-region "ess-tracebug" "(autoload).")
|
|||
|
(autoload 'ess-developer-send-function "ess-developer" "(autoload).")
|
|||
|
|
|||
|
;;*;; Process handling
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;; In this section:
|
|||
|
;;;
|
|||
|
;;; * User commands for starting an ESS process
|
|||
|
;;; * Functions called at startup
|
|||
|
;;; * Process handling code
|
|||
|
;;; * Multiple process implementation
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
;;*;; Starting a process
|
|||
|
|
|||
|
(defun ess-proc-name (n name)
|
|||
|
"Return name of process N, as a string, with NAME prepended.
|
|||
|
If ess-plain-first-buffername, then initial process is number-free."
|
|||
|
(concat name
|
|||
|
(if (not (and ess-plain-first-buffername
|
|||
|
(= n 1))) ; if not both first and plain-first add number
|
|||
|
(concat ":" (number-to-string n)))))
|
|||
|
|
|||
|
(defun inferior-ess (&optional ess-start-args customize-alist no-wait)
|
|||
|
"Start inferior ESS process.
|
|||
|
|
|||
|
Without a prefix argument, starts a new ESS process, or switches
|
|||
|
to the ESS process associated with the current buffer.
|
|||
|
With a prefix, starts the process with those args.
|
|||
|
The current buffer is used if it is an `inferior-ess-mode'
|
|||
|
or `ess-transcript-mode' buffer.
|
|||
|
|
|||
|
If `ess-ask-about-transfile' is non-nil, you will be asked for a
|
|||
|
transcript file to use. If there is no transcript file, the buffer
|
|||
|
name will be like *R* or *R2*, determined by `ess-gen-proc-buffer-name-function'.
|
|||
|
|
|||
|
Takes the program name from the variable `inferior-ess-program'.
|
|||
|
An initialization file (dumped into the process) is specified by
|
|||
|
`inferior-ess-start-file', and `inferior-ess-start-args' is used to
|
|||
|
accompany the call for `inferior-ess-program'.
|
|||
|
|
|||
|
When creating a new process, the process buffer replaces the
|
|||
|
current window if `inferior-ess-same-window' is non-nil.
|
|||
|
Alternatively, it can appear in its own frame if
|
|||
|
`inferior-ess-own-frame' is non-nil.
|
|||
|
|
|||
|
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
|
|||
|
|
|||
|
;; Use the current buffer if it is in inferior-ess-mode or ess-trans-mode
|
|||
|
;; If not, maybe ask about starting directory and/or transcript file.
|
|||
|
;; If no transfile, use buffer *S*
|
|||
|
;;
|
|||
|
;; This function is primarily used to figure out the Process and
|
|||
|
;; buffer names to use for inferior-ess.
|
|||
|
|
|||
|
;; Once, long ago, it was used for switching buffers, but we don't
|
|||
|
;; do that any more (at least not from here).
|
|||
|
|
|||
|
(interactive)
|
|||
|
|
|||
|
(let* ((ess-customize-alist (or customize-alist
|
|||
|
ess-customize-alist))
|
|||
|
(temp-ess-dialect (eval (cdr (assoc 'ess-dialect
|
|||
|
ess-customize-alist))))
|
|||
|
(temp-ess-lang (eval (cdr (assoc 'ess-language
|
|||
|
ess-customize-alist)))))
|
|||
|
|
|||
|
(run-hooks 'ess-pre-run-hook)
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(inf-ess 1): lang=%s, dialect=%s, tmp-dialect=%s, buf=%s\n"
|
|||
|
ess-language ess-dialect temp-ess-dialect (current-buffer)))
|
|||
|
(let* ((process-environment process-environment)
|
|||
|
(defdir (or (and ess-directory-function (funcall ess-directory-function))
|
|||
|
ess-directory default-directory))
|
|||
|
|
|||
|
(temp-dialect (if ess-use-inferior-program-name-in-buffer-name ;VS[23-02-2013]: fixme: this should not be here
|
|||
|
(if (string-equal temp-ess-dialect "R")
|
|||
|
inferior-R-program-name
|
|||
|
temp-ess-dialect) ; use temp-ess-dialect
|
|||
|
; if not R, R program name
|
|||
|
; otherwise.
|
|||
|
temp-ess-dialect))
|
|||
|
(temp-lang temp-ess-lang)
|
|||
|
(procname (let ((ntry 0) ;; find the next non-existent process N (*R:N*)
|
|||
|
(done nil))
|
|||
|
(while (not done)
|
|||
|
(setq ntry (1+ ntry)
|
|||
|
done (not
|
|||
|
(get-process (ess-proc-name
|
|||
|
ntry
|
|||
|
temp-dialect)))))
|
|||
|
(ess-proc-name ntry temp-dialect)))
|
|||
|
(buf-name-str (funcall ess-gen-proc-buffer-name-function procname))
|
|||
|
startdir buf method)
|
|||
|
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(inf-ess 1.1): procname=%s temp-dialect=%s, buf-name=%s \n"
|
|||
|
procname temp-dialect buf-name-str))
|
|||
|
|
|||
|
(cond
|
|||
|
;; 1) try to use current buffer, if inferior-ess-mode but no process
|
|||
|
((and (not (comint-check-proc (current-buffer)))
|
|||
|
(eq major-mode 'inferior-ess-mode))
|
|||
|
(setq startdir (if ess-ask-for-ess-directory
|
|||
|
(ess-get-directory defdir temp-dialect procname)
|
|||
|
defdir)
|
|||
|
buf (current-buffer)
|
|||
|
;; don't change existing buffer name in this case; It is very
|
|||
|
;; commong to restart the process in the same buffer.
|
|||
|
buf-name-str (buffer-name)
|
|||
|
method 1))
|
|||
|
|
|||
|
;; 2) Take the *R:N* buffer if already exists (and contains dead proc!)
|
|||
|
;; fixme: buffer name might have been changed, iterate over all
|
|||
|
;; inferior-ess buffers
|
|||
|
((get-buffer buf-name-str)
|
|||
|
(setq buf (get-buffer buf-name-str)
|
|||
|
method 2))
|
|||
|
|
|||
|
;; 3) Pick up a transcript file or create a new buffer
|
|||
|
(t
|
|||
|
(setq startdir (if ess-ask-for-ess-directory
|
|||
|
(ess-get-directory defdir temp-dialect procname)
|
|||
|
defdir)
|
|||
|
buf (if ess-ask-about-transfile
|
|||
|
(let ((transfilename (read-file-name "Use transcript file (default none):"
|
|||
|
startdir "")))
|
|||
|
(if (string= transfilename "")
|
|||
|
(get-buffer-create buf-name-str)
|
|||
|
(find-file-noselect (expand-file-name transfilename))))
|
|||
|
(get-buffer-create buf-name-str))
|
|||
|
method 3)))
|
|||
|
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(inf-ess 2.0) Method #%d start=%s buf=%s\n" method startdir buf))
|
|||
|
|
|||
|
(set-buffer buf)
|
|||
|
;; Now that we have the buffer, set buffer-local variables.
|
|||
|
(ess-setq-vars-local ess-customize-alist) ; buf)
|
|||
|
|
|||
|
;; Write out debug info
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(inf-ess 2.1): ess-language=%s, ess-dialect=%s buf=%s \n"
|
|||
|
ess-language ess-dialect (current-buffer)))
|
|||
|
|
|||
|
;; initialize.
|
|||
|
(if startdir (setq default-directory startdir))
|
|||
|
|
|||
|
;; the following was part of ess-multi;
|
|||
|
|
|||
|
(let* ((ess-directory (or startdir
|
|||
|
ess-directory))
|
|||
|
(infargs (or ess-start-args
|
|||
|
inferior-ess-start-args))
|
|||
|
(special-display-regexps nil)
|
|||
|
(special-display-frame-alist inferior-ess-frame-alist)
|
|||
|
(proc (get-process procname)))
|
|||
|
(if inferior-ess-own-frame
|
|||
|
(setq special-display-regexps '(".")))
|
|||
|
;; If ESS process NAME is running, switch to it
|
|||
|
(if (and proc (comint-check-proc (process-buffer proc)))
|
|||
|
(progn ;; fixme: when does this happen? -> log:
|
|||
|
(ess-write-to-dribble-buffer (format "(inf-ess ..): popping to proc\n"))
|
|||
|
(pop-to-buffer (process-buffer proc)))
|
|||
|
|
|||
|
;; Otherwise, crank up a new process
|
|||
|
(let* ((symbol-string
|
|||
|
(concat "inferior-" inferior-ess-program "-args"))
|
|||
|
(switches-symbol (intern-soft symbol-string))
|
|||
|
(switches
|
|||
|
(if (and switches-symbol (boundp switches-symbol))
|
|||
|
(symbol-value switches-symbol))))
|
|||
|
(set-buffer buf)
|
|||
|
(inferior-ess-mode)
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(inf-ess 3.0): prog=%s, start-args=%s, echoes=%s\n"
|
|||
|
inferior-ess-program infargs comint-process-echoes))
|
|||
|
(setq ess-local-process-name procname)
|
|||
|
(goto-char (point-max))
|
|||
|
;; load past history
|
|||
|
|
|||
|
;; Set up history file
|
|||
|
(if ess-history-file
|
|||
|
(if (eq t ess-history-file)
|
|||
|
(set (make-local-variable 'ess-history-file)
|
|||
|
(concat "." ess-dialect "history"))
|
|||
|
;; otherwise must be a string "..."
|
|||
|
(unless (stringp ess-history-file)
|
|||
|
(error "`ess-history-file' must be nil, t, or a string"))))
|
|||
|
|
|||
|
(when ess-history-file
|
|||
|
(setq comint-input-ring-file-name
|
|||
|
(expand-file-name ess-history-file
|
|||
|
(or ess-history-directory ess-directory)))
|
|||
|
(comint-read-input-ring))
|
|||
|
|
|||
|
;; create and run process.
|
|||
|
(set-buffer
|
|||
|
(if switches
|
|||
|
(inferior-ess-make-comint buf-name-str
|
|||
|
procname
|
|||
|
infargs
|
|||
|
switches)
|
|||
|
(inferior-ess-make-comint buf-name-str
|
|||
|
procname
|
|||
|
infargs)))
|
|||
|
|
|||
|
;; Set the process sentinel to save the history
|
|||
|
(set-process-sentinel (get-process procname) 'ess-process-sentinel)
|
|||
|
;; Add this process to ess-process-name-list, if needed
|
|||
|
(let ((conselt (assoc procname ess-process-name-list)))
|
|||
|
(if conselt nil
|
|||
|
(setq ess-process-name-list
|
|||
|
(cons (cons procname nil) ess-process-name-list))))
|
|||
|
(ess-make-buffer-current)
|
|||
|
(goto-char (point-max))
|
|||
|
(setq ess-sl-modtime-alist nil)
|
|||
|
|
|||
|
;; Add the process filter to catch certain output.
|
|||
|
(set-process-filter (get-process procname)
|
|||
|
'inferior-ess-output-filter)
|
|||
|
;; (inferior-ess-wait-for-prompt)
|
|||
|
(inferior-ess-mark-as-busy (get-process procname))
|
|||
|
(process-send-string (get-process procname) "\n") ;; to be sure we catch the prompt if user comp is super-duper fast.
|
|||
|
(unless no-wait
|
|||
|
(ess-write-to-dribble-buffer "(inferior-ess: waiting for process to start (before hook)\n")
|
|||
|
(ess-wait-for-process (get-process procname) nil 0.01))
|
|||
|
|
|||
|
;; arguments cache
|
|||
|
(ess-process-put 'funargs-cache (make-hash-table :test 'equal))
|
|||
|
(ess-process-put 'funargs-pre-cache nil)
|
|||
|
|
|||
|
;; set accumulation buffer name (buffer to cache output for faster display)
|
|||
|
(process-put (get-process procname) 'accum-buffer-name
|
|||
|
(format " *%s:accum*" procname))
|
|||
|
|
|||
|
|
|||
|
;; don't font-lock strings over process prompt
|
|||
|
(set (make-local-variable 'syntax-begin-function)
|
|||
|
#'inferior-ess-goto-last-prompt-if-close)
|
|||
|
(set (make-local-variable 'font-lock-fontify-region-function)
|
|||
|
#'inferior-ess-fontify-region)
|
|||
|
|
|||
|
(run-hooks 'ess-post-run-hook)
|
|||
|
|
|||
|
;; EXTRAS
|
|||
|
(ess-load-extras t)
|
|||
|
;; user initialization can take some time ...
|
|||
|
(unless no-wait
|
|||
|
(ess-write-to-dribble-buffer "(inferior-ess 3): waiting for process after hook")
|
|||
|
(ess-wait-for-process (get-process procname))))
|
|||
|
|
|||
|
(with-current-buffer buf
|
|||
|
(rename-buffer buf-name-str t))
|
|||
|
|
|||
|
(if (and inferior-ess-same-window (not inferior-ess-own-frame))
|
|||
|
(switch-to-buffer buf)
|
|||
|
(pop-to-buffer buf)))))))
|
|||
|
|
|||
|
|
|||
|
(defvar inferior-ess-objects-command nil
|
|||
|
"The language/dialect specific command for listing objects.
|
|||
|
It is initialized from the corresponding inferior-<lang>-objects-command
|
|||
|
and then made buffer local."); and the *-<lang>-* ones are customized!
|
|||
|
(make-variable-buffer-local 'inferior-ess-objects-command)
|
|||
|
|
|||
|
(defvar ess-save-lastvalue-command nil
|
|||
|
"The command to save the last value. See S section for more details.
|
|||
|
Default depends on the ESS language/dialect and hence made buffer local")
|
|||
|
(make-variable-buffer-local 'ess-save-lastvalue-command)
|
|||
|
|
|||
|
(defvar ess-retr-lastvalue-command nil
|
|||
|
"The command to retrieve the last value. See S section for more details.
|
|||
|
Default depends on the ESS language/dialect and hence made buffer local")
|
|||
|
(make-variable-buffer-local 'ess-retr-lastvalue-command)
|
|||
|
|
|||
|
;;; A note on multiple processes: the following variables
|
|||
|
;;; ess-local-process-name
|
|||
|
;;; ess-sl-modtime-alist
|
|||
|
;;; ess-prev-load-dir/file
|
|||
|
;;; ess-directory
|
|||
|
;;; ess-object-list
|
|||
|
;;; are specific to each ess-process and are buffer-local variables
|
|||
|
;;; local to the ESS process buffer. If required, these variables should
|
|||
|
;;; be accessed with the function ess-get-process-variable
|
|||
|
|
|||
|
|
|||
|
(defun inferior-ess-goto-last-prompt-if-close (&optional pos)
|
|||
|
"Staging from POS go to previous primary prompt and return the position.
|
|||
|
Look only for primary or secondary prompt on the current line. If
|
|||
|
found, return the starting position of the prompt, otherwise stay
|
|||
|
at current position and return nil. POS defaults to `point'."
|
|||
|
|
|||
|
(let* ((pos (or pos (point)))
|
|||
|
(new-pos (save-excursion
|
|||
|
(beginning-of-line)
|
|||
|
(if (looking-at inferior-ess-primary-prompt)
|
|||
|
pos
|
|||
|
(when (and inferior-ess-secondary-prompt
|
|||
|
(looking-at inferior-ess-secondary-prompt))
|
|||
|
(re-search-backward (concat "^" inferior-ess-primary-prompt))
|
|||
|
pos)))))
|
|||
|
(when new-pos
|
|||
|
(goto-char new-pos))))
|
|||
|
|
|||
|
(defvar compilation--parsed)
|
|||
|
(defvar ess--tb-last-input)
|
|||
|
(defvar compilation--parsed)
|
|||
|
(defun inferior-ess-fontify-region (beg end &optional verbose)
|
|||
|
"Fontify output by output within the beg-end region to avoid
|
|||
|
fontification spilling over prompts."
|
|||
|
(let* ((buffer-undo-list t)
|
|||
|
(inhibit-point-motion-hooks t)
|
|||
|
(font-lock-dont-widen t)
|
|||
|
(buff (current-buffer))
|
|||
|
(pos0 (or (inferior-ess-goto-last-prompt-if-close beg)
|
|||
|
beg))
|
|||
|
(pos1 pos0) pos2)
|
|||
|
(when (< pos0 end)
|
|||
|
(with-silent-modifications
|
|||
|
;; fontify chunks from prompt to prompt
|
|||
|
(while (< pos1 end)
|
|||
|
(goto-char pos1)
|
|||
|
(comint-next-prompt 1)
|
|||
|
(setq pos2 (min (point) end))
|
|||
|
(save-restriction
|
|||
|
(narrow-to-region pos1 pos2)
|
|||
|
(font-lock-default-fontify-region pos1 pos2 verbose))
|
|||
|
(setq pos1 pos2))
|
|||
|
;; highlight errors
|
|||
|
(setq compilation--parsed beg)
|
|||
|
;; emacs 23 doesn't have this function
|
|||
|
(when (fboundp 'compilation--ensure-parse)
|
|||
|
;; this line is a workaround for occasional incomplete highlighting of
|
|||
|
;; compilation errors on remotes, but it causes an incredible
|
|||
|
;; slowdown. See https://github.com/emacs-ess/ESS/issues/258.
|
|||
|
;; (compilation--ensure-parse end)
|
|||
|
)
|
|||
|
`(jit-lock-bounds ,pos0 . ,end)))))
|
|||
|
|
|||
|
(defun ess-gen-proc-buffer-name:simple (proc-name)
|
|||
|
"Function to generate buffer name by wrapping PROC-NAME in *proc-name*.
|
|||
|
See `ess-gen-proc-buffer-name-function'."
|
|||
|
(format "*%s*" proc-name))
|
|||
|
|
|||
|
(defun ess-gen-proc-buffer-name:directory (proc-name)
|
|||
|
"Function to generate buffer name by wrapping PROC-NAME in *PROC-NAME:DIR-NAME*.
|
|||
|
DIR-NAME is a short directory name. See
|
|||
|
`ess-gen-proc-buffer-name-function'."
|
|||
|
(format "*%s:%s*" proc-name (file-name-nondirectory
|
|||
|
(directory-file-name default-directory))))
|
|||
|
|
|||
|
(defun ess-gen-proc-buffer-name:abbr-long-directory (proc-name)
|
|||
|
"Function to generate buffer name in the form *PROC-NAME:ABBREVIATED-LONG-DIR-NAME*.
|
|||
|
PROC-NAME is a string representing an internal process
|
|||
|
name. ABBREVIATED-LONG-DIR-NAME is an abbreviated full directory
|
|||
|
name. Abbreviation is performed by `abbreviate-file-name'. See
|
|||
|
`ess-gen-proc-buffer-name-function'."
|
|||
|
(format "*%s:%s*" proc-name (abbreviate-file-name default-directory)))
|
|||
|
|
|||
|
(defun ess-gen-proc-buffer-name:projectile-or-simple (proc-name)
|
|||
|
"Function to generate buffer name in the form *PROC-NAME:PROJECTILE-ROOT*.
|
|||
|
PROC-NAME is a string representing an internal process
|
|||
|
name. PROJECTILE-ROOT is directory name returned by
|
|||
|
`projectile-project-root' if defined. If
|
|||
|
`projectile-project-root' is undefined or no project directory
|
|||
|
has been found use `ess-gen-proc-buffer-name:simple'. See
|
|||
|
`ess-gen-proc-buffer-name-function'."
|
|||
|
(let ((proj (and (fboundp 'projectile-project-root)
|
|||
|
(projectile-project-p))))
|
|||
|
(if proj
|
|||
|
(format "*%s:%s*" proc-name (file-name-nondirectory
|
|||
|
(directory-file-name proj)))
|
|||
|
(ess-gen-proc-buffer-name:simple proc-name))))
|
|||
|
|
|||
|
(defun ess-gen-proc-buffer-name:projectile-or-directory (proc-name)
|
|||
|
"Function to generate buffer name in the form *PROC-NAME:PROJECTILE-ROOT*.
|
|||
|
PROC-NAME is a string representing an internal process
|
|||
|
name. PROJECTILE-ROOT is directory name returned by
|
|||
|
`projectile-project-root' if defined. If
|
|||
|
`projectile-project-root' is undefined, or no project directory
|
|||
|
has been found, use `ess-gen-proc-buffer-name:directory'. See
|
|||
|
`ess-gen-proc-buffer-name-function'."
|
|||
|
(let ((proj (and (fboundp 'projectile-project-root)
|
|||
|
(projectile-project-p))))
|
|||
|
(if proj
|
|||
|
(format "*%s:%s*" proc-name (file-name-nondirectory
|
|||
|
(directory-file-name proj)))
|
|||
|
(ess-gen-proc-buffer-name:directory proc-name))))
|
|||
|
|
|||
|
(defun inferior-ess-set-status (proc string &optional no-timestamp)
|
|||
|
"Internal function to set the satus of the PROC
|
|||
|
If no-timestamp, don't set the last-eval timestamp.
|
|||
|
Return the 'busy state."
|
|||
|
;; todo: do it in one search, use starting position, use prog1
|
|||
|
(let ((busy (not (string-match (concat "\\(" inferior-ess-primary-prompt "\\)\\'") string))))
|
|||
|
(process-put proc 'busy-end? (and (not busy)
|
|||
|
(process-get proc 'busy)))
|
|||
|
(when (not busy)
|
|||
|
(process-put proc 'running-async? nil))
|
|||
|
(process-put proc 'busy busy)
|
|||
|
(process-put proc 'sec-prompt
|
|||
|
(when inferior-ess-secondary-prompt
|
|||
|
(string-match (concat "\\(" inferior-ess-secondary-prompt "\\)\\'") string)))
|
|||
|
(unless no-timestamp
|
|||
|
(process-put proc 'last-eval (current-time)))
|
|||
|
busy))
|
|||
|
|
|||
|
(defun inferior-ess-mark-as-busy (proc)
|
|||
|
(process-put proc 'busy t)
|
|||
|
(process-put proc 'sec-prompt nil))
|
|||
|
|
|||
|
(defun inferior-ess-run-callback (proc string)
|
|||
|
;; callback is stored in 'callbacks proc property. Callbacks is a list that
|
|||
|
;; can contain either functions to be called with two artuments PROC and
|
|||
|
;; STRING, or cons cells of the form (func . suppress). If SUPPRESS is non-nil
|
|||
|
;; next process output will be suppressed.
|
|||
|
(unless (process-get proc 'busy)
|
|||
|
;; only one callback is implemented for now
|
|||
|
(let* ((cb (car (process-get proc 'callbacks)))
|
|||
|
(listp (not (functionp cb)))
|
|||
|
(suppress (and listp (consp cb) (cdr cb)))
|
|||
|
(cb (if (and listp (consp cb))
|
|||
|
(car cb)
|
|||
|
cb)))
|
|||
|
(when cb
|
|||
|
(when ess-verbose
|
|||
|
(ess-write-to-dribble-buffer "executing callback ...\n"))
|
|||
|
(when suppress
|
|||
|
(process-put proc 'suppress-next-output? t))
|
|||
|
(process-put proc 'callbacks nil)
|
|||
|
(condition-case err
|
|||
|
(funcall cb proc string)
|
|||
|
(error (message "%s" (error-message-string err))))))))
|
|||
|
|
|||
|
(defun ess--if-verbose-write-process-state (proc string &optional filter)
|
|||
|
(ess-if-verbose-write
|
|||
|
(format "\n%s:
|
|||
|
--> busy:%s busy-end:%s sec-prompt:%s interruptable:%s <--
|
|||
|
--> running-async:%s callback:%s suppress-next-output:%s <--
|
|||
|
--> dbg-active:%s is-recover:%s <--
|
|||
|
--> string:%s\n"
|
|||
|
(or filter "NORMAL-FILTER")
|
|||
|
(process-get proc 'busy)
|
|||
|
(process-get proc 'busy-end?)
|
|||
|
(process-get proc 'sec-prompt)
|
|||
|
(process-get proc 'interruptable?)
|
|||
|
(process-get proc 'running-async?)
|
|||
|
(if (process-get proc 'callbacks) "yes")
|
|||
|
(process-get proc 'suppress-next-output?)
|
|||
|
(process-get proc 'dbg-active)
|
|||
|
(process-get proc 'is-recover)
|
|||
|
(if (> (length string) 150)
|
|||
|
(format "%s .... %s" (substring string 0 50) (substring string -50))
|
|||
|
string))))
|
|||
|
|
|||
|
(defun inferior-ess-output-filter (proc string)
|
|||
|
"Standard output filter for the inferior ESS process.
|
|||
|
Ring Emacs bell if process output starts with an ASCII bell, and pass
|
|||
|
the rest to `comint-output-filter'.
|
|||
|
Taken from octave-mod.el."
|
|||
|
(inferior-ess-set-status proc string)
|
|||
|
(ess--if-verbose-write-process-state proc string)
|
|||
|
(inferior-ess-run-callback proc string)
|
|||
|
(if (process-get proc 'suppress-next-output?)
|
|||
|
;; works only for surpressing short output, for time being is enough (for callbacks)
|
|||
|
(process-put proc 'suppress-next-output? nil)
|
|||
|
(comint-output-filter proc (inferior-ess-strip-ctrl-g string))
|
|||
|
(ess--show-process-buffer-on-error string proc)))
|
|||
|
|
|||
|
|
|||
|
(defun ess--show-process-buffer-on-error (string proc)
|
|||
|
(let ((case-fold-search nil))
|
|||
|
(when (string-match "Error\\(:\\| +in\\)" string)
|
|||
|
(ess-show-buffer (process-buffer proc)))))
|
|||
|
|
|||
|
(defun inferior-ess-strip-ctrl-g (string)
|
|||
|
"Strip leading `^G' character.
|
|||
|
If STRING starts with a `^G', ring the Emacs bell and strip it.
|
|||
|
Depending on the value of `visible-bell', either the frame will
|
|||
|
flash or you'll hear a beep. Taken from octave-mod.el."
|
|||
|
(if (string-match "^\a" string)
|
|||
|
(progn
|
|||
|
(ding)
|
|||
|
(setq string (substring string 1))))
|
|||
|
string)
|
|||
|
|
|||
|
|
|||
|
(defun ess-process-sentinel (proc message)
|
|||
|
"Sentinel for use with ESS processes.
|
|||
|
This marks the process with a message, at a particular time point."
|
|||
|
(save-excursion
|
|||
|
(setq message (substring message 0 -1)) ; strip newline
|
|||
|
(set-buffer (process-buffer proc))
|
|||
|
(comint-write-input-ring)
|
|||
|
(goto-char (point-max))
|
|||
|
(insert-before-markers
|
|||
|
(format "\nProcess %s %s at %s\n"
|
|||
|
(process-name proc) message (current-time-string)))))
|
|||
|
|
|||
|
(defun inferior-ess-make-comint (bufname
|
|||
|
procname
|
|||
|
infargs
|
|||
|
&rest switches)
|
|||
|
"Make an S comint process in buffer BUFNAME with process PROCNAME."
|
|||
|
;;; This function is a modification of make-comint from the comint.el
|
|||
|
;;; code of Olin Shivers.
|
|||
|
(let* ((buffer (get-buffer-create bufname))
|
|||
|
(proc (get-process procname)))
|
|||
|
;; If no process, or nuked process, crank up a new one and put buffer in
|
|||
|
;; comint mode. Otherwise, leave buffer and existing process alone.
|
|||
|
(cond ((or (not proc) (not (memq (process-status proc) '(run stop))))
|
|||
|
(with-current-buffer buffer
|
|||
|
(if ess-directory (setq default-directory ess-directory))
|
|||
|
(if (eq (buffer-size) 0) nil
|
|||
|
(goto-char (point-max))
|
|||
|
(insert "\^L\n"))) ; page boundaries = Interactive sessions
|
|||
|
(let ((process-environment
|
|||
|
(nconc
|
|||
|
(list "STATATERM=emacs"
|
|||
|
(format "PAGER=%s" inferior-ess-pager))
|
|||
|
process-environment))
|
|||
|
(tramp-remote-process-environment
|
|||
|
(nconc ;; it contains a pager already, so append
|
|||
|
(when (boundp 'tramp-remote-process-environment)
|
|||
|
(copy-sequence tramp-remote-process-environment))
|
|||
|
(list "STATATERM=emacs"
|
|||
|
(format "PAGER=%s" inferior-ess-pager)))))
|
|||
|
(ess-write-to-dribble-buffer "Making Process...")
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "Buf %s, :Proc %s, :Prog %s\n :Args= %s\nStart File=%s\n"
|
|||
|
buffer
|
|||
|
procname
|
|||
|
inferior-ess-program
|
|||
|
infargs
|
|||
|
inferior-ess-start-file))
|
|||
|
(comint-exec buffer
|
|||
|
procname
|
|||
|
inferior-ess-program
|
|||
|
inferior-ess-start-file
|
|||
|
(ess-line-to-list-of-words
|
|||
|
infargs)))))
|
|||
|
buffer))
|
|||
|
|
|||
|
|
|||
|
;;*;; Requester functions called at startup
|
|||
|
|
|||
|
(defun ess-get-directory (default dialect procname)
|
|||
|
(let ((prog-version (cond ((string= dialect "R")
|
|||
|
(concat ", " inferior-R-version)) ; notably for the R-X.Y versions
|
|||
|
(inferior-ess-program
|
|||
|
(concat ", " inferior-ess-program ))
|
|||
|
(t ""))))
|
|||
|
(ess-prompt-for-directory
|
|||
|
(directory-file-name default)
|
|||
|
(format "ESS (*%s*%s) starting data directory? "
|
|||
|
procname prog-version)
|
|||
|
;; (format "ESS [%s {%s(%s)}: '%s'] starting data directory? "
|
|||
|
;; ;;FIXME: maybe rather tmp-dialect (+ evt drop ess-language?)?
|
|||
|
;; procname ess-language ess-dialect prog-version)
|
|||
|
)))
|
|||
|
|
|||
|
|
|||
|
(defun ess-prompt-for-directory (default prompt)
|
|||
|
"`prompt' for a directory, using `default' as the usual."
|
|||
|
(let* ((def-dir (file-name-as-directory default))
|
|||
|
(the-dir (expand-file-name
|
|||
|
(file-name-as-directory
|
|||
|
(read-directory-name prompt def-dir def-dir t nil)))))
|
|||
|
(if (file-directory-p the-dir) nil
|
|||
|
(error "%s is not a valid directory" the-dir))
|
|||
|
the-dir))
|
|||
|
|
|||
|
|
|||
|
;;*;; General process handling code
|
|||
|
(defmacro with-ess-process-buffer (no-error &rest body)
|
|||
|
"Execute BODY with current-buffer set to the process buffer of ess-current-process-name.
|
|||
|
If NO-ERROR is t don't trigger error when there is not current
|
|||
|
process.
|
|||
|
|
|||
|
Symbol *proc* is bound to the current process during the evaluation of BODY."
|
|||
|
(declare (indent 1) (debug t))
|
|||
|
`(let ((*proc* (and ess-local-process-name (get-process ess-local-process-name))))
|
|||
|
(if *proc*
|
|||
|
(with-current-buffer (process-buffer *proc*)
|
|||
|
,@body)
|
|||
|
(unless ,no-error
|
|||
|
(error "No current ESS process")))))
|
|||
|
|
|||
|
(defmacro ess-with-current-buffer (buffer &rest body)
|
|||
|
"Like `with-current-buffer' but with transfer of some essential
|
|||
|
local ESS vars like `ess-local-process-name'"
|
|||
|
(declare (indent 1) (debug t))
|
|||
|
(let ((lpn (make-symbol "lpn"))
|
|||
|
(alist (make-symbol "alist")))
|
|||
|
`(let ((,lpn ess-local-process-name)
|
|||
|
(,alist ess-local-customize-alist))
|
|||
|
(with-current-buffer ,buffer
|
|||
|
(ess-setq-vars-local (eval ,alist))
|
|||
|
(setq ess-local-process-name ,lpn)
|
|||
|
,@body))))
|
|||
|
|
|||
|
(dolist (mode '(emacs-lisp-mode lisp-interaction-mode))
|
|||
|
(font-lock-add-keywords
|
|||
|
mode
|
|||
|
'(("(\\(ess-with-current-buffer\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"
|
|||
|
(1 font-lock-keyword-face)
|
|||
|
(2 font-lock-variable-name-face)))))
|
|||
|
|
|||
|
(defun ess-get-process (&optional name use-another)
|
|||
|
"Return the ESS process named by NAME. If USE-ANOTHER is non-nil,
|
|||
|
and the process NAME is not running (anymore), try to connect to another if
|
|||
|
there is one. By default (USE-ANOTHER is nil), the connection to another
|
|||
|
process happens interactively (when possible)."
|
|||
|
(setq name (or name ess-local-process-name))
|
|||
|
(if (null name) ; should almost never happen at this point
|
|||
|
(error "No ESS process is associated with this buffer now"))
|
|||
|
(update-ess-process-name-list)
|
|||
|
(if (assoc name ess-process-name-list)
|
|||
|
(get-process name)
|
|||
|
;; else :
|
|||
|
;; was (error "Process %s is not running" name)
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "ess-get-process: process '%s' not running" name))
|
|||
|
(if (= 0 (length ess-process-name-list))
|
|||
|
(save-current-buffer
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format " .. restart proc %s for language %s (buf %s)\n"
|
|||
|
name ess-language (current-buffer)))
|
|||
|
(message "trying to (re)start process %s for language %s ..."
|
|||
|
name ess-language)
|
|||
|
(ess-start-process-specific ess-language ess-dialect)
|
|||
|
;; and return the process: "call me again"
|
|||
|
(ess-get-process name))
|
|||
|
|
|||
|
;; else: there are other running processes
|
|||
|
(if use-another ; connect to another running process : the first one
|
|||
|
(let ((other-name (car (elt ess-process-name-list 0))))
|
|||
|
;; "FIXME": try to find the process name that matches *closest*
|
|||
|
(message "associating with *other* process '%s'" other-name)
|
|||
|
(ess-get-process other-name))
|
|||
|
;; else
|
|||
|
(ding)
|
|||
|
(if (y-or-n-p
|
|||
|
(format "Process %s is not running, but others are. Switch? " name))
|
|||
|
(progn
|
|||
|
(ess-force-buffer-current
|
|||
|
(concat ess-dialect " process to use: ") 'force)
|
|||
|
(ess-get-process ess-current-process-name))
|
|||
|
(error "Process %s is not running" name))))))
|
|||
|
|
|||
|
|
|||
|
;; (defun inferior-ess-wait-for-prompt ()
|
|||
|
;; "Wait until the ESS process is ready for input."
|
|||
|
;; (let* ((cbuffer (current-buffer))
|
|||
|
;; (sprocess (ess-get-process ess-current-process-name))
|
|||
|
;; (sbuffer (process-buffer sprocess))
|
|||
|
;; (r nil)
|
|||
|
;; (timeout 0))
|
|||
|
;; (set-buffer sbuffer)
|
|||
|
;; (while (progn
|
|||
|
;; (if (not (eq (process-status sprocess) 'run))
|
|||
|
;; (ess-error "ESS process has died unexpectedly.")
|
|||
|
;; (if (> (setq timeout (1+ timeout)) ess-loop-timeout)
|
|||
|
;; (ess-error "Timeout waiting for prompt. Check inferior-ess-prompt or ess-loop-timeout."))
|
|||
|
;; (accept-process-output)
|
|||
|
;; (goto-char (point-max))
|
|||
|
;; (beginning-of-line); bol ==> no need for "^" in *-prompt! (MM?)
|
|||
|
;; ;; above, except for Stata, which has "broken" i/o,
|
|||
|
;; ;; sigh... (AJR)
|
|||
|
;; (setq r (looking-at inferior-ess-prompt))
|
|||
|
;; (not (or r (looking-at ".*\\?\\s *"))))))
|
|||
|
;; (goto-char (point-max))
|
|||
|
;; (set-buffer cbuffer)
|
|||
|
;; (symbol-value r)))
|
|||
|
|
|||
|
;;--- Unfinished idea (ESS-help / R-help ) -- probably not worth it...
|
|||
|
;;- (defun ess-set-inferior-program-name (filename)
|
|||
|
;;- "Allows to set or change `inferior-ess-program', the program (file)name."
|
|||
|
;;- (interactive "fR executable (script) file: ")
|
|||
|
;;- ;; "f" : existing file {file name completion} !
|
|||
|
;;- (setq inferior-ess-program filename))
|
|||
|
;; the inferior-ess-program is initialized in the customize..alist,
|
|||
|
;; e.g. from inferior-R-program-name ... --> should change rather these.
|
|||
|
;; However these really depend on the current ess-language!
|
|||
|
;; Plan: 1) must know and use ess-language
|
|||
|
;; 2) change the appropriate inferior-<ESSlang>-program-name
|
|||
|
;; (how?) in R/S : assign(paste("inferior-",ESSlang,"-p...."), filename))
|
|||
|
|
|||
|
;;*;; Multiple process handling code
|
|||
|
|
|||
|
(defun ess-make-buffer-current nil
|
|||
|
"Make the process associated with the current buffer the current ESS process.
|
|||
|
Returns the name of the process, or nil if the current buffer has none."
|
|||
|
(update-ess-process-name-list)
|
|||
|
;; (if ess-local-process-name
|
|||
|
;; (setq ess-current-process-name ess-local-process-name))
|
|||
|
ess-local-process-name)
|
|||
|
|
|||
|
(defun ess-get-process-variable (var)
|
|||
|
"Return the variable VAR (symbol) local to ESS process called NAME (string)."
|
|||
|
(buffer-local-value var (process-buffer (ess-get-process ess-local-process-name))))
|
|||
|
|
|||
|
(defun ess-set-process-variable (var val)
|
|||
|
"Set variable VAR (symbol) local to ESS process called NAME (string) to VAL."
|
|||
|
(with-current-buffer (process-buffer (ess-get-process ess-local-process-name))
|
|||
|
(set var val)))
|
|||
|
|
|||
|
;; emacs 23 compatibility
|
|||
|
(unless (fboundp 'process-live-p)
|
|||
|
(defun process-live-p (process)
|
|||
|
"Returns non-nil if PROCESS is alive.
|
|||
|
A process is considered alive if its status is `run', `open',
|
|||
|
`listen', `connect' or `stop'."
|
|||
|
(memq (process-status process)
|
|||
|
'(run open listen connect stop))))
|
|||
|
|
|||
|
(defun ess-process-live-p ()
|
|||
|
"Check if the local ess process is alive.
|
|||
|
Return nil if current buffer has no associated process, or
|
|||
|
process was killed."
|
|||
|
(and ess-local-process-name
|
|||
|
(let ((proc (get-process ess-local-process-name)))
|
|||
|
(and (processp proc)
|
|||
|
(process-live-p proc)))))
|
|||
|
|
|||
|
(defun ess-process-get (propname)
|
|||
|
"Return the variable PROPNAME (symbol) from the plist of the
|
|||
|
current ESS process."
|
|||
|
(process-get (get-process ess-local-process-name) propname))
|
|||
|
|
|||
|
(defun ess-process-put (propname value)
|
|||
|
"Set the variable PROPNAME (symbol) to VALUE in the plist of
|
|||
|
the current ESS process."
|
|||
|
(process-put (get-process ess-local-process-name) propname value))
|
|||
|
|
|||
|
(defun ess-start-process-specific (language dialect)
|
|||
|
"Start an ESS process typically from a language-specific buffer, using
|
|||
|
LANGUAGE (and DIALECT)."
|
|||
|
|
|||
|
(unless dialect
|
|||
|
(error "The value of `dialect' is nil"))
|
|||
|
|
|||
|
(save-current-buffer
|
|||
|
(let ((dsymb (intern dialect)))
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format " ..start-process-specific: lang:dialect= %s:%s, current-buf=%s\n"
|
|||
|
language dialect (current-buffer)))
|
|||
|
(cond ;; ((string= dialect "R") (R))
|
|||
|
;; ((string= language "S") ;
|
|||
|
;; (message "ESS process not running, trying to start R, since language = 'S")
|
|||
|
;; (R))
|
|||
|
;; ((string= dialect STA-dialect-name) (stata))
|
|||
|
;;general case
|
|||
|
((fboundp dsymb)
|
|||
|
(funcall dsymb))
|
|||
|
(t ;; else: ess-dialect is not a function
|
|||
|
|
|||
|
;; Typically triggered from
|
|||
|
;; ess-force-buffer-current("Process to load into: ")
|
|||
|
;; \--> ess-request-a-process("Process to load into: " no-switch)
|
|||
|
(error "No ESS processes running; not yet implemented to start (%s,%s)"
|
|||
|
language dialect)))
|
|||
|
;; save excursion is not working here !!! bad bad bad !!
|
|||
|
)))
|
|||
|
|
|||
|
(defun ess-request-a-process (message &optional noswitch ask-if-1)
|
|||
|
"Ask for a process, and make it the current ESS process.
|
|||
|
If there is exactly one process, only ask if ASK-IF-1 is non-nil.
|
|||
|
Also switches to the process buffer unless NOSWITCH is non-nil. Interactively,
|
|||
|
NOSWITCH can be set by giving a prefix argument.
|
|||
|
Returns the name of the selected process."
|
|||
|
(interactive
|
|||
|
(list "Switch to which ESS process? " current-prefix-arg))
|
|||
|
; prefix sets 'noswitch
|
|||
|
(ess-write-to-dribble-buffer "ess-request-a-process: {beginning}\n")
|
|||
|
(update-ess-process-name-list)
|
|||
|
|
|||
|
(setq ess-dialect
|
|||
|
(or ess-dialect (ess-completing-read
|
|||
|
"Set `ess-dialect'"
|
|||
|
(delete-dups (list "R" "S+" S+-dialect-name
|
|||
|
"stata" STA-dialect-name
|
|||
|
"julia" "SAS" "XLS" "ViSta")))))
|
|||
|
|
|||
|
(let* ((pname-list (delq nil ;; keep only those mathing dialect
|
|||
|
(append
|
|||
|
(mapcar (lambda (lproc)
|
|||
|
(and (equal ess-dialect
|
|||
|
(buffer-local-value
|
|||
|
'ess-dialect
|
|||
|
(process-buffer (get-process (car lproc)))))
|
|||
|
(not (equal ess-local-process-name (car lproc)))
|
|||
|
(car lproc)))
|
|||
|
ess-process-name-list)
|
|||
|
;; append local only if running
|
|||
|
(when (assoc ess-local-process-name ess-process-name-list)
|
|||
|
(list ess-local-process-name)))))
|
|||
|
(num-processes (length pname-list))
|
|||
|
(inferior-ess-same-window nil) ;; this should produce the inferior process in other window
|
|||
|
(auto-started?))
|
|||
|
(if (or (= 0 num-processes)
|
|||
|
(and (= 1 num-processes)
|
|||
|
(not (equal ess-dialect ;; don't auto connect if from different dialect
|
|||
|
(buffer-local-value
|
|||
|
'ess-dialect
|
|||
|
(process-buffer (get-process
|
|||
|
(car pname-list))))))))
|
|||
|
;; try to start "the appropriate" process
|
|||
|
(progn
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(concat " ... request-a-process:\n "
|
|||
|
(format
|
|||
|
"major mode %s; current buff: %s; ess-language: %s, ess-dialect: %s\n"
|
|||
|
major-mode (current-buffer) ess-language ess-dialect)))
|
|||
|
(ess-start-process-specific ess-language ess-dialect)
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format " ... request-a-process: buf=%s\n" (current-buffer)))
|
|||
|
(setq num-processes 1
|
|||
|
pname-list (car ess-process-name-list)
|
|||
|
auto-started? t)))
|
|||
|
;; now num-processes >= 1 :
|
|||
|
(let* ((proc-buffers (mapcar (lambda (lproc)
|
|||
|
(buffer-name (process-buffer (get-process lproc))))
|
|||
|
pname-list))
|
|||
|
(proc
|
|||
|
(if (or auto-started?
|
|||
|
(and (not ask-if-1) (= 1 num-processes)))
|
|||
|
(progn
|
|||
|
(message "using process '%s'" (car proc-buffers))
|
|||
|
(car pname-list))
|
|||
|
;; else
|
|||
|
(unless (and ess-current-process-name
|
|||
|
(get-process ess-current-process-name))
|
|||
|
(setq ess-current-process-name nil))
|
|||
|
(when message
|
|||
|
(setq message (replace-regexp-in-string ": +\\'" "" message))) ;; <- why is this here??
|
|||
|
;; ask for buffer name not the *real* process name:
|
|||
|
(let ((buf (ess-completing-read message (append proc-buffers (list "*new*")) nil t nil nil)))
|
|||
|
(if (equal buf "*new*")
|
|||
|
(progn
|
|||
|
(ess-start-process-specific ess-language ess-dialect) ;; switches to proc-buff
|
|||
|
(caar ess-process-name-list))
|
|||
|
(process-name (get-buffer-process buf))
|
|||
|
))
|
|||
|
)))
|
|||
|
(if noswitch
|
|||
|
(pop-to-buffer (current-buffer)) ;; VS: this is weired, but is necessary
|
|||
|
(pop-to-buffer (buffer-name (process-buffer (get-process proc))) t))
|
|||
|
proc)))
|
|||
|
|
|||
|
|
|||
|
(defun ess-force-buffer-current (&optional prompt force no-autostart ask-if-1)
|
|||
|
"Make sure the current buffer is attached to an ESS process.
|
|||
|
If not, or FORCE (prefix argument) is non-nil, prompt for a
|
|||
|
process name with PROMPT. If NO-AUTOSTART is nil starts the new
|
|||
|
process if process associated with current buffer has
|
|||
|
died. `ess-local-process-name' is set to the name of the process
|
|||
|
selected. `ess-dialect' is set to the dialect associated with
|
|||
|
the process selected. ASK-IF-1 asks user for the process, even if
|
|||
|
there is only one process running."
|
|||
|
(interactive
|
|||
|
(list (concat ess-dialect " process to use: ") current-prefix-arg nil))
|
|||
|
;; fixme: why the above interactive is not working in emacs 24?
|
|||
|
(setq prompt (or prompt "Process to use: "))
|
|||
|
(let ((proc-name (ess-make-buffer-current)))
|
|||
|
(if (and (not force) proc-name (get-process proc-name))
|
|||
|
nil ; do nothing
|
|||
|
;; Make sure the source buffer is attached to a process
|
|||
|
(if (and ess-local-process-name (not force) no-autostart)
|
|||
|
(error "Process %s has died" ess-local-process-name)
|
|||
|
;; ess-local-process-name is nil -- which process to attach to
|
|||
|
(let ((proc (ess-request-a-process prompt 'no-switch ask-if-1))
|
|||
|
temp-ess-help-filetype dialect)
|
|||
|
(with-current-buffer (process-buffer (get-process proc))
|
|||
|
(setq temp-ess-help-filetype inferior-ess-help-filetype))
|
|||
|
(setq ess-local-process-name proc)
|
|||
|
(setq inferior-ess-help-filetype temp-ess-help-filetype))))))
|
|||
|
|
|||
|
(defun ess-switch-process ()
|
|||
|
"Force a switch to a new underlying process."
|
|||
|
(interactive)
|
|||
|
(ess-force-buffer-current "Process to use: " 'force nil 'ask-if-1))
|
|||
|
|
|||
|
(defun ess-get-next-available-process (&optional dialect ignore-busy)
|
|||
|
"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."
|
|||
|
(setq dialect (or dialect ess-dialect))
|
|||
|
(when dialect
|
|||
|
(let (proc)
|
|||
|
(catch 'found
|
|||
|
(dolist (p (cons ess-local-process-name
|
|||
|
(mapcar 'car ess-process-name-list)))
|
|||
|
(when p
|
|||
|
(setq proc (get-process p))
|
|||
|
(when (and proc
|
|||
|
(process-live-p proc)
|
|||
|
(equal dialect
|
|||
|
(buffer-local-value 'ess-dialect (process-buffer proc)))
|
|||
|
(or ignore-busy
|
|||
|
(not (process-get proc 'busy))))
|
|||
|
(throw 'found proc))))))))
|
|||
|
|
|||
|
|
|||
|
;;*;;; Commands for switching to the process buffer
|
|||
|
|
|||
|
(defun ess-switch-to-ESS (eob-p)
|
|||
|
"Switch to the current inferior ESS process buffer.
|
|||
|
With (prefix) EOB-P non-nil, positions cursor at end of buffer.
|
|||
|
This function should follow the description in `ess-show-buffer'
|
|||
|
for showing the iESS buffer, except that the iESS buffer is also
|
|||
|
made current."
|
|||
|
(interactive "P")
|
|||
|
(ess-force-buffer-current)
|
|||
|
(if (and ess-current-process-name (get-process ess-current-process-name))
|
|||
|
(progn
|
|||
|
;; Display the buffer, but don't select it yet.
|
|||
|
(ess-show-buffer
|
|||
|
(buffer-name (process-buffer (get-process ess-current-process-name)))
|
|||
|
t)
|
|||
|
(if eob-p (goto-char (point-max))))
|
|||
|
(message "No inferior ESS process")
|
|||
|
(ding)))
|
|||
|
|
|||
|
(defun ess-switch-to-ESS-deprecated (eob-p)
|
|||
|
(interactive "P")
|
|||
|
(ess-switch-to-ESS eob-p)
|
|||
|
(message "C-c C-y is deprecated, use C-c C-z instead (ess-switch-to-inferior-or-script-buffer)"))
|
|||
|
|
|||
|
|
|||
|
(defun ess-switch-to-end-of-ESS ()
|
|||
|
"Switch to the end of the inferior ESS process buffer."
|
|||
|
(interactive)
|
|||
|
(ess-switch-to-ESS t))
|
|||
|
|
|||
|
(defun ess-switch-to-inferior-or-script-buffer (toggle-eob)
|
|||
|
"If in script, switch to the iESS. If in iESS switch to most recent script buffer.
|
|||
|
|
|||
|
This is a single-key command. Assuming that it is bound to C-c C-z,
|
|||
|
you can navigate back and forth between iESS and script buffer
|
|||
|
with C-c C-z C-z C-z ...
|
|||
|
|
|||
|
If variable `ess-switch-to-end-of-proc-buffer' is t (the default)
|
|||
|
this function switches to the end of process buffer.
|
|||
|
|
|||
|
If TOGGLE-EOB is given, the value of
|
|||
|
`ess-switch-to-end-of-proc-buffer' is toggled.
|
|||
|
"
|
|||
|
(interactive "P")
|
|||
|
(let ((map (make-sparse-keymap))
|
|||
|
(EOB (if toggle-eob
|
|||
|
(not ess-switch-to-end-of-proc-buffer)
|
|||
|
ess-switch-to-end-of-proc-buffer)))
|
|||
|
(define-key map (vector last-command-event)
|
|||
|
(lambda (ev eob) (interactive)
|
|||
|
(if (not (eq major-mode 'inferior-ess-mode))
|
|||
|
(ess-switch-to-ESS eob)
|
|||
|
(let ((dialect ess-dialect)
|
|||
|
(loc-proc-name ess-local-process-name)
|
|||
|
(blist (cdr (buffer-list))))
|
|||
|
(while (and blist
|
|||
|
(with-current-buffer (car blist)
|
|||
|
(not (or (and
|
|||
|
(memq major-mode '(ess-mode ess-julia-mode))
|
|||
|
(equal dialect ess-dialect)
|
|||
|
(null ess-local-process-name))
|
|||
|
(and
|
|||
|
(memq major-mode '(ess-mode ess-julia-mode))
|
|||
|
(equal loc-proc-name ess-local-process-name))
|
|||
|
))))
|
|||
|
(pop blist))
|
|||
|
(if blist
|
|||
|
(ess-show-buffer (car blist) t)
|
|||
|
(message "Found no buffers for ess-dialect %s associated with process %s"
|
|||
|
dialect loc-proc-name))))))
|
|||
|
(ess--execute-electric-command map nil nil nil EOB)))
|
|||
|
|
|||
|
|
|||
|
(defun ess-get-process-buffer (&optional name)
|
|||
|
"Return the buffer associated with the ESS process named by NAME."
|
|||
|
(process-buffer (ess-get-process (or name ess-local-process-name))))
|
|||
|
|
|||
|
(defun update-ess-process-name-list ()
|
|||
|
"Remove names with no process."
|
|||
|
(let (defunct)
|
|||
|
(dolist (conselt ess-process-name-list)
|
|||
|
(let ((proc (get-process (car conselt))))
|
|||
|
(unless (and proc (eq (process-status proc) 'run))
|
|||
|
(push conselt defunct))))
|
|||
|
(dolist (pointer defunct)
|
|||
|
(setq ess-process-name-list (delq pointer ess-process-name-list))))
|
|||
|
(if (eq (length ess-process-name-list) 0)
|
|||
|
(setq ess-current-process-name nil)))
|
|||
|
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;; ess-show-buffer
|
|||
|
;; Something like this almost works, but problems with XEmacs and Emacs
|
|||
|
;; differing implementations of the args to display-buffer make this
|
|||
|
;; too tough to pursue. The longer version below works.
|
|||
|
;; (defun ess-show-buffer (buf)
|
|||
|
;; "Display the buffer BUF, a string, but do not select it.
|
|||
|
;; Returns the window corresponding to the buffer."
|
|||
|
;; ;; On XEmacs, I get an error if third arg to display-buffer is t and
|
|||
|
;; ;; the BUF is in another frame. Emacs does not have this problem.
|
|||
|
;; (if (featurep 'xemacs)
|
|||
|
;; (display-buffer buf nil (get-frame-for-buffer buf))
|
|||
|
;; (display-buffer buf nil t)))
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
(defcustom ess-show-buffer-action
|
|||
|
'((display-buffer-pop-up-window display-buffer-use-some-window))
|
|||
|
"Actions for `ess-show-buffer', passed to `display-buffer'."
|
|||
|
:group 'ess
|
|||
|
:type 'list)
|
|||
|
(defun ess-show-buffer (buf &optional visit)
|
|||
|
"Ensure the ESS buffer BUF is visible.
|
|||
|
The buffer, specified as a string, is typically an iESS (e.g. *R*) buffer.
|
|||
|
|
|||
|
This handles several cases:
|
|||
|
|
|||
|
1. If BUF is visible in the current frame, nothing is done.
|
|||
|
2. If BUF is visible in another frame, then we ensure that frame is
|
|||
|
visible (it may have been iconified).
|
|||
|
3. If buffer is not visible in any frame, simply show it in another window
|
|||
|
in the current frame.
|
|||
|
|
|||
|
If VISIT is non-nil, as well as making BUF visible, we also select it
|
|||
|
as the current buffer."
|
|||
|
(let ((frame))
|
|||
|
(if (ess-buffer-visible-this-frame buf)
|
|||
|
;;1. Nothing to do, BUF visible in this frame; just return window
|
|||
|
;; where this buffer is.
|
|||
|
t
|
|||
|
|
|||
|
;; 2. Maybe BUF visible in another frame.
|
|||
|
(setq frame (ess-buffer-visible-other-frame buf))
|
|||
|
(if frame
|
|||
|
;; BUF is visible in frame, so just check frame is raised.
|
|||
|
(if (not (eq (frame-visible-p frame) t))
|
|||
|
;; frame is not yet visible, so raise it.
|
|||
|
(raise-frame frame))
|
|||
|
;; 3. else BUF not visible in any frame, so show it (but do
|
|||
|
;; not select it) in another window in current frame.
|
|||
|
(display-buffer buf ess-show-buffer-action)))
|
|||
|
;; At this stage, the buffer should now be visible on screen,
|
|||
|
;; although it won't have been made current.
|
|||
|
(when visit
|
|||
|
;; Need to select the buffer.
|
|||
|
;;
|
|||
|
;; First of all, check case 2 if buffer is in another frame
|
|||
|
;; but that frame may not be selected.
|
|||
|
(if frame
|
|||
|
(ess-select-frame-set-input-focus frame))
|
|||
|
(select-window (get-buffer-window buf 0)))))
|
|||
|
|
|||
|
|
|||
|
(defvar ess-bufs-in-frame nil) ;silence the compiler.
|
|||
|
;; The next few functions are copied from my (SJE) iswitchb library.
|
|||
|
(defun ess-get-bufname (win)
|
|||
|
"Used by `ess-get-buffers-in-frames' to walk through all windows."
|
|||
|
(let ((buf (buffer-name (window-buffer win))))
|
|||
|
(if (not (member buf ess-bufs-in-frame))
|
|||
|
;; Only add buf if it is not already in list.
|
|||
|
;; This prevents same buf in two different windows being
|
|||
|
;; put into the list twice.
|
|||
|
(setq ess-bufs-in-frame
|
|||
|
(cons buf ess-bufs-in-frame)))))
|
|||
|
|
|||
|
(defun ess-get-buffers-in-frames (&optional current)
|
|||
|
"Return the list of buffers that are visible in the current frame.
|
|||
|
If optional argument CURRENT is given, restrict searching to the
|
|||
|
current frame, rather than all frames."
|
|||
|
(let ((ess-bufs-in-frame nil))
|
|||
|
(walk-windows 'ess-get-bufname nil (if current nil 0))
|
|||
|
ess-bufs-in-frame))
|
|||
|
|
|||
|
(defun ess-buffer-visible-this-frame (buf)
|
|||
|
"Return t if BUF is visible in current frame."
|
|||
|
(member buf (ess-get-buffers-in-frames t)))
|
|||
|
|
|||
|
(defun ess-buffer-visible-other-frame (buf)
|
|||
|
"Return t if BUF is visible in another frame.
|
|||
|
Assumes that buffer has not already been in found in current frame."
|
|||
|
(if (member (buffer-name (get-buffer buf)) (ess-get-buffers-in-frames))
|
|||
|
(window-frame (get-buffer-window buf 0))
|
|||
|
nil))
|
|||
|
|
|||
|
|
|||
|
; Functions for evaluating code
|
|||
|
|
|||
|
(defun ess-ddeclient-p ()
|
|||
|
"Returns t iff `ess-local-process-name' is associated with an
|
|||
|
inferior-ess-ddeclient, and nil if the ess-process is running as an
|
|||
|
ordinary inferior process. Alway nil on Unix machines."
|
|||
|
(interactive)
|
|||
|
(if ess-microsoft-p
|
|||
|
(progn
|
|||
|
;; Debug: C-c C-l fails (to start R or give good message) in Windows
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "*ddeclient-p: ess-loc-proc-name is '%s'" ess-local-process-name))
|
|||
|
(ess-force-buffer-current "Process to load into: ")
|
|||
|
(not (equal (ess-get-process-variable 'inferior-ess-ddeclient)
|
|||
|
(default-value 'inferior-ess-ddeclient))))))
|
|||
|
|
|||
|
;; (defun ess-prompt-wait (proc prompt-reg &optional sleep )
|
|||
|
;; "Wait for a prompt to appear at the end of current buffer.
|
|||
|
;; PROC is the ESS process. PROMPT-REG is a regexp of the process
|
|||
|
;; prompt to look for. Does not change point. Not to be used in
|
|||
|
;; inferior-process buffer. Use `inferior-ess-wait-for-prompt'
|
|||
|
;; instead. "
|
|||
|
;; (if sleep (sleep-for sleep)); we sleep here, *and* wait below
|
|||
|
;; (save-excursion
|
|||
|
;; (while (or (accept-process-output proc 0 100)
|
|||
|
;; (progn ;; if no more output, check for prompt
|
|||
|
;; (goto-char (marker-position (process-mark proc)))
|
|||
|
;; (beginning-of-line)
|
|||
|
;; (not (re-search-forward prompt-reg nil t))
|
|||
|
;; )))))
|
|||
|
|
|||
|
(defun ess-wait-for-process (&optional proc sec-prompt wait force-redisplay)
|
|||
|
"Wait for 'busy property of the process to become nil.
|
|||
|
If SEC-PROMPT is non-nil return if secondary prompt is detected
|
|||
|
regardless of whether primary prompt was detected or not. If
|
|||
|
WAIT is non-nil wait for WAIT seconds for process output before
|
|||
|
the prompt check, default 0.001s. When FORCE-REDISPLAY is non-nil
|
|||
|
force redisplay. You better use WAIT >= 0.1 if you need
|
|||
|
FORCE-REDISPLAY to avoid excesive redisplay."
|
|||
|
(setq proc (or proc (get-process ess-local-process-name)))
|
|||
|
(unless (eq (process-status proc) 'run)
|
|||
|
(ess-error "ESS process has died unexpectedly."))
|
|||
|
(setq wait (or wait 0.002)) ;;xemacs is stuck if it's 0 here
|
|||
|
(let ((start-time (float-time)))
|
|||
|
(save-excursion
|
|||
|
(while (or (accept-process-output proc wait)
|
|||
|
(if (and sec-prompt (process-get proc 'sec-prompt))
|
|||
|
nil
|
|||
|
(if force-redisplay (redisplay 'force))
|
|||
|
(process-get proc 'busy)))
|
|||
|
(if (> (- (float-time) start-time) .5)
|
|||
|
(setq wait .5))))))
|
|||
|
|
|||
|
;; (defun inferior-ess-ordinary-filter (proc string)
|
|||
|
;; (let ((old-buffer (current-buffer)))
|
|||
|
;; (unwind-protect
|
|||
|
;; (let (moving)
|
|||
|
;; (set-buffer (process-buffer proc))
|
|||
|
;; (setq moving (= (point) (process-mark proc)))
|
|||
|
;; (save-excursion
|
|||
|
;; ;; Insert the text, moving the process-marker.
|
|||
|
;; (goto-char (process-mark proc))
|
|||
|
;; (insert string)
|
|||
|
;; (set-marker (process-mark proc) (point)))
|
|||
|
;; (if moving (goto-char (process-mark proc))))
|
|||
|
;; (set-buffer old-buffer))))
|
|||
|
|
|||
|
(defun inferior-ess-ordinary-filter (proc string)
|
|||
|
(inferior-ess-set-status proc string t)
|
|||
|
(ess--if-verbose-write-process-state proc string "ordinary-filter")
|
|||
|
(inferior-ess-run-callback proc string)
|
|||
|
(with-current-buffer (process-buffer proc)
|
|||
|
;; (princ (format "%s:" string))
|
|||
|
(insert string)))
|
|||
|
|
|||
|
|
|||
|
(defvar ess-presend-filter-functions nil
|
|||
|
"List of functions to call before sending the input string to the process.
|
|||
|
Each function gets one argument, a string containing the text to
|
|||
|
be send to the subprocess. It should return the string sent,
|
|||
|
perhaps the same string that was received, or perhaps a modified
|
|||
|
or transformed string.
|
|||
|
|
|||
|
The functions on the list are called sequentially, and each one is
|
|||
|
given the string returned by the previous one. The string returned by
|
|||
|
the last function is the text that is actually sent to the process.
|
|||
|
|
|||
|
You can use `add-hook' to add functions to this list either
|
|||
|
globally or locally.
|
|||
|
|
|||
|
The hook is executed in current buffer. Before execution, the
|
|||
|
local value of this hook in the process buffer is appended to the
|
|||
|
hook from the current buffer.
|
|||
|
")
|
|||
|
|
|||
|
(defun ess-send-region (process start end &optional visibly message)
|
|||
|
"Low level ESS version of `process-send-region'.
|
|||
|
If VISIBLY call `ess-eval-linewise', else call `ess-send-string'.
|
|||
|
If MESSAGE is supplied, display it at the end.
|
|||
|
|
|||
|
Run `comint-input-filter-functions' and curent buffer's and
|
|||
|
associated with PROCESS `ess-presend-filter-functions' hooks.
|
|||
|
"
|
|||
|
(if (ess-ddeclient-p)
|
|||
|
(ess-eval-region-ddeclient start end 'even-empty)
|
|||
|
;; else: "normal", non-DDE behavior:
|
|||
|
(ess-send-string process (buffer-substring start end) visibly message)))
|
|||
|
|
|||
|
(defvar ess-send-string-function nil)
|
|||
|
(make-variable-buffer-local 'ess-send-string-function)
|
|||
|
|
|||
|
(defun ess-send-string (process string &optional visibly message)
|
|||
|
"ESS wrapper for `process-send-string'.
|
|||
|
STRING need not end with \\n.
|
|||
|
|
|||
|
Run `comint-input-filter-functions' and current buffer's and
|
|||
|
PROCESS' `ess-presend-filter-functions' hooks on the input
|
|||
|
STRING.
|
|||
|
|
|||
|
VISIBLY can be nil, t, 'nowait or a string. If string the
|
|||
|
behavior is as with 'nowait with the differences that inserted
|
|||
|
string is VISIBLY instead of STRING (evaluated command is still
|
|||
|
STRING). In all other cases the behavior is as described in
|
|||
|
`ess-eval-visibly'.
|
|||
|
"
|
|||
|
(setq string (ess--run-presend-hooks process string))
|
|||
|
(inferior-ess--interrupt-subjob-maybe process)
|
|||
|
(inferior-ess-mark-as-busy process)
|
|||
|
(if (fboundp (buffer-local-value 'ess-send-string-function
|
|||
|
(current-buffer)))
|
|||
|
;; overloading
|
|||
|
(funcall ess-send-string-function process string visibly)
|
|||
|
(when (and (eq visibly t)
|
|||
|
(null inferior-ess-secondary-prompt)) ; cannot evaluate visibly
|
|||
|
(setq visibly 'nowait))
|
|||
|
(cond ((eq visibly t) ;; wait after each line
|
|||
|
(let ((ess--inhibit-presend-hooks t))
|
|||
|
(ess-eval-linewise string)))
|
|||
|
((or (stringp visibly)
|
|||
|
(eq visibly 'nowait)) ;; insert command and eval invisibly .
|
|||
|
(with-current-buffer (process-buffer process)
|
|||
|
(save-excursion
|
|||
|
(goto-char (process-mark process))
|
|||
|
(insert-before-markers
|
|||
|
(propertize (format "%s\n"
|
|||
|
(replace-regexp-in-string
|
|||
|
"\n[ \t]" "\n+ "
|
|||
|
(if (stringp visibly) visibly string)))
|
|||
|
'font-lock-face 'comint-highlight-input)))
|
|||
|
(process-send-string process (ess--concat-new-line-maybe string))))
|
|||
|
(t
|
|||
|
(process-send-string process (ess--concat-new-line-maybe string)))))
|
|||
|
(if message (message message)))
|
|||
|
|
|||
|
(defvar ess--inhibit-presend-hooks nil
|
|||
|
"If non-nil don't run presend hooks.")
|
|||
|
|
|||
|
(defun ess--run-presend-hooks (process string)
|
|||
|
;; run ess-presend-filter-functions and comint-input-filter-functions
|
|||
|
(if ess--inhibit-presend-hooks
|
|||
|
string
|
|||
|
;;return modified string
|
|||
|
(let* ((pbuf (process-buffer process))
|
|||
|
;; also run proc buffer local hooks
|
|||
|
(functions (unless (eq pbuf (current-buffer))
|
|||
|
(buffer-local-value 'ess-presend-filter-functions pbuf))))
|
|||
|
(setq functions (append (delq t (copy-sequence functions)) ;; even in let, delq distructs
|
|||
|
ess-presend-filter-functions))
|
|||
|
(while (and functions string)
|
|||
|
;; cannot use run-hook-with-args here because string must be passed from one
|
|||
|
;; function to another
|
|||
|
(if (eq (car functions) t)
|
|||
|
(let ((functions
|
|||
|
(default-value 'ess-presend-filter-functions)))
|
|||
|
(while (and functions string)
|
|||
|
(setq string (funcall (car functions) string))
|
|||
|
(setq functions (cdr functions))))
|
|||
|
(setq string (funcall (car functions) string)))
|
|||
|
(setq functions (cdr functions)))
|
|||
|
|
|||
|
(with-current-buffer pbuf
|
|||
|
(run-hook-with-args 'comint-input-filter-functions string))
|
|||
|
|
|||
|
string)))
|
|||
|
|
|||
|
(defun ess--concat-new-line-maybe (string)
|
|||
|
"Append \\n at the end of STRING if missing."
|
|||
|
(if (string-match "\n\\'" string (max (- (length string) 2) 0))
|
|||
|
string
|
|||
|
(concat string "\n")))
|
|||
|
|
|||
|
|
|||
|
(defvar ess--dbg-del-empty-p t
|
|||
|
"Internal variable to control removal of empty lines during the
|
|||
|
debugging. Let-bind it to nil before calling
|
|||
|
`ess-send-string' or `ess-send-region' if no
|
|||
|
removal is necessary.")
|
|||
|
|
|||
|
(defun inferior-ess--interrupt-subjob-maybe (proc)
|
|||
|
"Internal. Interrupt the process if interruptable? process variable is non-nil.
|
|||
|
Hide all the junk output in temporary buffer."
|
|||
|
(when (process-get proc 'interruptable?)
|
|||
|
(let ((cb (cadr (process-get proc 'callbacks)))
|
|||
|
(buf (get-buffer-create " *ess-temp-buff*"))
|
|||
|
(old-filter (process-filter proc))
|
|||
|
(old-buff (process-buffer proc)))
|
|||
|
(unwind-protect
|
|||
|
(progn
|
|||
|
(ess-if-verbose-write "interrupting subjob ... start")
|
|||
|
(process-put proc 'interruptable? nil)
|
|||
|
(process-put proc 'callbacks nil)
|
|||
|
(process-put proc 'running-async? nil)
|
|||
|
;; this is to avoid putting junk in user's buffer on process
|
|||
|
;; interruption
|
|||
|
(set-process-buffer proc buf)
|
|||
|
(set-process-filter proc 'inferior-ess-ordinary-filter)
|
|||
|
(interrupt-process proc)
|
|||
|
(when cb
|
|||
|
(ess-if-verbose-write "executing interruption callback ... ")
|
|||
|
(funcall cb proc))
|
|||
|
;; should be very fast as it inputs only the prompt
|
|||
|
(ess-wait-for-process proc)
|
|||
|
(ess-if-verbose-write "interrupting subjob ... finished")
|
|||
|
)
|
|||
|
(set-process-buffer proc old-buff)
|
|||
|
(set-process-filter proc old-filter)))))
|
|||
|
|
|||
|
(defun ess-async-command-delayed (com &optional buf proc callback delay)
|
|||
|
"Delayed asynchronous ess-command.
|
|||
|
COM and BUF are as in `ess-command'. DELAY is a number of idle
|
|||
|
seconds to wait before starting the execution of the COM. On
|
|||
|
interruption (by user's evaluation) ESS tries to rerun the job
|
|||
|
after next DELAY seconds, and the whole process repeats itself
|
|||
|
until the command manages to run completely.
|
|||
|
|
|||
|
DELAY defaults to `ess-idle-timer-interval' + 3 seconds
|
|||
|
|
|||
|
You should always provide PROC for delayed evaluation, as the
|
|||
|
current process might change, leading to unpredictable
|
|||
|
consequences.
|
|||
|
|
|||
|
This function is a wrapper of `ess-async-command' with an
|
|||
|
explicit interrupt-callback."
|
|||
|
(unless proc
|
|||
|
(error "You must provide PROC argument to ess-async-command-delayed"))
|
|||
|
(let* ((timer (make-symbol "timer"))
|
|||
|
(delay (or delay
|
|||
|
(+ ess-idle-timer-interval 3)))
|
|||
|
(int-cb `(lambda (proc)
|
|||
|
(ess-async-command-delayed ,com ,buf proc ,callback ,delay)))
|
|||
|
(com-fun `(lambda ()
|
|||
|
(when (eq (process-status ,proc) 'run) ; do nothing if not running
|
|||
|
(if (or (process-get ,proc 'busy) ; if busy, try later
|
|||
|
(process-get ,proc 'running-async?))
|
|||
|
;; idle timer doesn't work here
|
|||
|
(run-with-timer ,delay nil 'ess-async-command-delayed
|
|||
|
,com ,buf ,proc ,callback ,delay))
|
|||
|
(ess-async-command ,com ,buf ,proc ,callback ',int-cb)))))
|
|||
|
(run-with-idle-timer delay nil com-fun)))
|
|||
|
|
|||
|
;; ;;; VS[03-09-2012]: Test Cases:
|
|||
|
;; (ess-command "a<-0\n" nil nil nil nil (get-process "R"))
|
|||
|
;; (ess-async-command-delayed "Sys.sleep(5);a<-a+1;cat(1:10)\n" nil
|
|||
|
;; (get-process "R") (lambda (proc) (message "done")))
|
|||
|
|
|||
|
;; (ess-async-command-delayed "Sys.sleep(5)\n" nil (get-process "R")
|
|||
|
;; (lambda (proc) (message "done")))
|
|||
|
|
|||
|
;; (process-get (get-process "R") 'running-async?)
|
|||
|
|
|||
|
;; (ess-async-command "{cat(1:5);Sys.sleep(5);cat(2:6)}\n" nil (get-process "R")
|
|||
|
;; (lambda (proc) (message "done")))
|
|||
|
;; (ess-async-command "{cat(1:5);Sys.sleep(5);cat(2:6)}\n" nil (get-process "R")
|
|||
|
;; (lambda (proc) (message "done"))
|
|||
|
;; t)
|
|||
|
;; (ess-async-command "{cat(1:5);Sys.sleep(5);cat(2:6)}\n" nil (get-process "R")
|
|||
|
;; (lambda (proc) (message "done"))
|
|||
|
;; (lambda (proc2) (message "name: %s" (process-name proc2))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-async-command (com &optional buf proc callback interrupt-callback )
|
|||
|
"Asynchronous version of ess-command.
|
|||
|
COM, BUF, WAIT and PROC are as in `ess-command'.
|
|||
|
|
|||
|
CALLBACK is a function of two arguments (PROC STRING) to run
|
|||
|
after the successful execution. When INTERRUPT-CALLBACK is
|
|||
|
non-nil, user evaluation can interrupt the
|
|||
|
job. INTERRUPT-CALLBACK should be either t or a function of one
|
|||
|
argument (PROC) to be called on interruption.
|
|||
|
|
|||
|
NOTE: Currently this function should be used only for background
|
|||
|
jobs like caching. ESS tries to suppress any output from the
|
|||
|
asynchronous command, but long output of COM will most likely end
|
|||
|
up in user's main buffer.
|
|||
|
"
|
|||
|
(let ((proc (or proc (get-process ess-local-process-name))))
|
|||
|
(if (not (and proc
|
|||
|
(eq (process-status proc) 'run)))
|
|||
|
(error "Process %s is dead" ess-local-process-name)
|
|||
|
(if (or (process-get proc 'busy)
|
|||
|
(process-get proc 'running-async?))
|
|||
|
(error "Process %s is busy or already running an async command." ess-local-process-name)
|
|||
|
(when (eq interrupt-callback t)
|
|||
|
(setq interrupt-callback (lambda (proc))))
|
|||
|
(process-put proc 'callbacks (list (cons callback 'suppress-output)
|
|||
|
interrupt-callback))
|
|||
|
(process-put proc 'interruptable? (and interrupt-callback t))
|
|||
|
(process-put proc 'running-async? t)
|
|||
|
(ess-command com buf nil 'no-prompt-check .01 proc)))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-command (com &optional buf sleep no-prompt-check wait proc force-redisplay)
|
|||
|
"Send the ESS process command COM and delete the output from
|
|||
|
the ESS process buffer. If an optional second argument BUF
|
|||
|
exists save the output in that buffer. BUF is erased before
|
|||
|
use. COM should have a terminating newline. Guarantees that the
|
|||
|
value of .Last.value will be preserved. When optional third arg
|
|||
|
SLEEP is non-nil, `(sleep-for (* a SLEEP))' will be used in a few
|
|||
|
places where `a' is proportional to `ess-cmd-delay'. WAIT and
|
|||
|
FORCE-REDISPLAY are as in `ess-wait-for-process' and are passed
|
|||
|
to `ess-wait-for-process'.
|
|||
|
|
|||
|
PROC should be a process, if nil the process name is taken from
|
|||
|
`ess-local-process-name'. This command doesn't set 'last-eval
|
|||
|
process variable.
|
|||
|
|
|||
|
Note: for critical, or error prone code you should consider
|
|||
|
wrapping the code into:
|
|||
|
|
|||
|
local({
|
|||
|
olderr <- options(error=NULL)
|
|||
|
on.exit(options(olderr))
|
|||
|
...
|
|||
|
})
|
|||
|
"
|
|||
|
;; Use this function when you need to evaluate some S code, and the
|
|||
|
;; result is needed immediately. Waits until the output is ready
|
|||
|
|
|||
|
;; the ddeclient-p checks needs to use the local-process-name
|
|||
|
(unless buf
|
|||
|
(setq buf (get-buffer-create " *ess-command-output*")))
|
|||
|
|
|||
|
(if (ess-ddeclient-p)
|
|||
|
(ess-command-ddeclient com buf sleep)
|
|||
|
|
|||
|
;; else: "normal", non-DDE behavior:
|
|||
|
|
|||
|
(let* ((sprocess (or proc (ess-get-process ess-local-process-name)))
|
|||
|
sbuffer primary-prompt end-of-output oldpb oldpf oldpm
|
|||
|
)
|
|||
|
|
|||
|
(unless sprocess
|
|||
|
;; should hardly happen, since (ess-get-process *) already checked:
|
|||
|
(error "Process %s is not running!" ess-current-process-name))
|
|||
|
(setq sbuffer (process-buffer sprocess))
|
|||
|
(with-current-buffer sbuffer
|
|||
|
(unless ess-local-process-name
|
|||
|
(setq ess-local-process-name (process-name sprocess))) ; let it be here (calling functions need not set it explicitly)
|
|||
|
(setq primary-prompt inferior-ess-primary-prompt)
|
|||
|
(ess-if-verbose-write (format "n(ess-command %s ..)" com))
|
|||
|
(unless no-prompt-check
|
|||
|
(when (process-get sprocess 'busy) ;;(looking-at inferior-ess-primary-prompt)
|
|||
|
(ess-error
|
|||
|
"ESS process not ready. Finish your command before trying again.")))
|
|||
|
(setq oldpf (process-filter sprocess))
|
|||
|
(setq oldpb (process-buffer sprocess))
|
|||
|
(setq oldpm (marker-position (process-mark sprocess)))
|
|||
|
;; need the buffer-local values in result buffer "buf":
|
|||
|
(unwind-protect
|
|||
|
(progn
|
|||
|
(set-process-buffer sprocess buf)
|
|||
|
(set-process-filter sprocess 'inferior-ess-ordinary-filter)
|
|||
|
;; Output is now going to BUF:
|
|||
|
(with-current-buffer buf
|
|||
|
(setq inferior-ess-primary-prompt primary-prompt) ;; set local value
|
|||
|
(setq buffer-read-only nil)
|
|||
|
(erase-buffer)
|
|||
|
(set-marker (process-mark sprocess) (point-min))
|
|||
|
(inferior-ess-mark-as-busy sprocess)
|
|||
|
(process-send-string sprocess com)
|
|||
|
;; need time for ess-create-object-name-db on PC
|
|||
|
(if no-prompt-check
|
|||
|
(sleep-for 0.020); 0.1 is noticeable!
|
|||
|
;; else: default
|
|||
|
(ess-wait-for-process sprocess nil wait force-redisplay)
|
|||
|
(goto-char (point-max))
|
|||
|
;; remove prompt
|
|||
|
;; if output is cat(..)ed this deletes the output ...
|
|||
|
(delete-region (point-at-bol) (point-max)))
|
|||
|
(ess-if-verbose-write " .. ok{ess-command}")
|
|||
|
))
|
|||
|
|
|||
|
(ess-if-verbose-write " .. exiting{ess-command}\n")
|
|||
|
;; Restore old values for process filter
|
|||
|
(set-process-buffer sprocess oldpb)
|
|||
|
(set-process-filter sprocess oldpf)
|
|||
|
(set-marker (process-mark sprocess) oldpm))))
|
|||
|
buf))
|
|||
|
|
|||
|
(defun ess-boolean-command (com &optional buf wait)
|
|||
|
"Like `ess-command' but expects COM to print TRUE or FALSE.
|
|||
|
If TRUE (or true) is found return non-nil otherwise nil.
|
|||
|
|
|||
|
Example: (ess-boolean-command \"2>1\n\")"
|
|||
|
(with-current-buffer (ess-command com buf nil nil wait)
|
|||
|
(goto-char (point-min))
|
|||
|
(let ((case-fold-search t))
|
|||
|
(re-search-forward "true" nil t))))
|
|||
|
|
|||
|
(defun ess-replace-in-string (str regexp newtext &optional literal)
|
|||
|
"Replace all matches in STR for REGEXP with NEWTEXT string.
|
|||
|
Optional LITERAL non-nil means do a literal replacement.
|
|||
|
Otherwise treat \\ in NEWTEXT string as special:
|
|||
|
\\& means substitute original matched text,
|
|||
|
\\N means substitute match for \(...\) number N,
|
|||
|
\\\\ means insert one \\."
|
|||
|
(if (not (stringp str))
|
|||
|
(error "(replace-in-string): First argument must be a string: %s" str))
|
|||
|
(if (stringp newtext)
|
|||
|
nil
|
|||
|
(error "(replace-in-string): 3rd arg must be a string: %s"
|
|||
|
newtext))
|
|||
|
(let ((rtn-str "")
|
|||
|
(start 0)
|
|||
|
(special)
|
|||
|
match prev-start)
|
|||
|
(while (setq match (string-match regexp str start))
|
|||
|
(setq prev-start start
|
|||
|
start (match-end 0)
|
|||
|
rtn-str
|
|||
|
(concat
|
|||
|
rtn-str
|
|||
|
(substring str prev-start match)
|
|||
|
(cond (literal newtext)
|
|||
|
(t (mapconcat
|
|||
|
(function
|
|||
|
(lambda (c)
|
|||
|
(if special
|
|||
|
(progn
|
|||
|
(setq special nil)
|
|||
|
(cond ((eq c ?\\) "\\")
|
|||
|
((eq c ?&)
|
|||
|
(substring str
|
|||
|
(match-beginning 0)
|
|||
|
(match-end 0)))
|
|||
|
((and (>= c ?0) (<= c ?9))
|
|||
|
(if (> c (+ ?0 (length
|
|||
|
(match-data))))
|
|||
|
;; Invalid match num
|
|||
|
(error "(replace-in-string) Invalid match num: %c" c)
|
|||
|
(setq c (- c ?0))
|
|||
|
(substring str
|
|||
|
(match-beginning c)
|
|||
|
(match-end c))))
|
|||
|
(t (char-to-string c))))
|
|||
|
(if (eq c ?\\) (progn (setq special t) nil)
|
|||
|
(char-to-string c)))))
|
|||
|
newtext ""))))))
|
|||
|
(concat rtn-str (substring str start))))
|
|||
|
|
|||
|
|
|||
|
|
|||
|
;;*;; Evaluating lines, paragraphs, regions, and buffers.
|
|||
|
|
|||
|
;;--- The two basic building blocks [called by all other ess-eval..] are
|
|||
|
;; (ess-eval-linewise ....)
|
|||
|
;; and
|
|||
|
;; (ess-eval-region ....)
|
|||
|
|
|||
|
(defun ess-eval-linewise (text &optional invisibly eob even-empty
|
|||
|
wait-last-prompt sleep-sec wait-sec)
|
|||
|
;; RDB 28/8/92 added optional arg eob
|
|||
|
;; MM 2006-08-23: added 'timeout-ms' -- but the effect seems "nil"
|
|||
|
;; VS 2012-01-18 it was actually nil, replaced with wait-sec - 0.001 default
|
|||
|
;; MM 2007-01-05: added 'sleep-sec' VS:? this one seems redundant to wait-last-prompt
|
|||
|
"Evaluate TEXT in the ESS process buffer as if typed in w/o tabs.
|
|||
|
Waits for prompt after each line of input, so won't break on large texts.
|
|||
|
|
|||
|
If optional second arg INVISIBLY is non-nil, don't echo commands.
|
|||
|
If it is a string, just include that string. If optional third
|
|||
|
arg EOB is non-nil go to end of ESS process buffer after
|
|||
|
evaluation. If optional 4th arg EVEN-EMPTY is non-nil, also send
|
|||
|
empty text (e.g. an empty line). If 5th arg WAIT-LAST-PROMPT is
|
|||
|
non-nil, also wait for the prompt after the last line; if 6th arg
|
|||
|
SLEEP-SEC is a number, ESS will call '(\\[sleep-for] SLEEP-SEC)
|
|||
|
at the end of this function. If the 7th arg WAIT-SEC is set, it
|
|||
|
will be used instead of the default .001s and be passed to
|
|||
|
\\[ess-wait-for-process].
|
|||
|
|
|||
|
Run `comint-input-filter-functions' and
|
|||
|
`ess-presend-filter-functions' of the associated PROCESS on the
|
|||
|
TEXT."
|
|||
|
(if (ess-ddeclient-p)
|
|||
|
(ess-eval-linewise-ddeclient text
|
|||
|
invisibly eob even-empty
|
|||
|
(if wait-last-prompt
|
|||
|
ess-eval-ddeclient-sleep))
|
|||
|
|
|||
|
;; else: "normal", non-DDE behavior:
|
|||
|
(unless (numberp wait-sec)
|
|||
|
(setq wait-sec 0.001)) ;;don't make it lower (0.); xemacs is stuck
|
|||
|
|
|||
|
(ess-force-buffer-current "Process to use: ")
|
|||
|
|
|||
|
;; Use this to evaluate some code, but don't wait for output.
|
|||
|
(let* ((deactivate-mark); keep local {do *not* deactivate wrongly}
|
|||
|
(cbuffer (current-buffer))
|
|||
|
(sprocess (ess-get-process ess-current-process-name))
|
|||
|
(sbuffer (process-buffer sprocess))
|
|||
|
(win (get-buffer-window sbuffer t))
|
|||
|
;; (text (ess-replace-in-string text "\t" " "))
|
|||
|
com pos txt-gt-0)
|
|||
|
|
|||
|
(setq text (ess--concat-new-line-maybe
|
|||
|
(ess--run-presend-hooks sprocess text)))
|
|||
|
|
|||
|
(with-current-buffer sbuffer
|
|||
|
|
|||
|
;; (when (and win
|
|||
|
;; (null eob)
|
|||
|
;; (<= (process-mark sprocess) (point)))
|
|||
|
;; (setq eob t))
|
|||
|
;; (setq wait-last-prompt t)
|
|||
|
|
|||
|
;; the following is required to make sure things work!
|
|||
|
(when (string= ess-language "STA")
|
|||
|
(if ess-sta-delimiter-friendly;; RAS: mindless replacement of semi-colons
|
|||
|
(setq text (ess-replace-in-string text ";" "\n")))
|
|||
|
(setq invisibly t))
|
|||
|
(setq text (propertize text 'field 'input 'front-sticky t))
|
|||
|
|
|||
|
(goto-char (marker-position (process-mark sprocess)))
|
|||
|
(if (stringp invisibly)
|
|||
|
(insert-before-markers (concat "*** " invisibly " ***\n")))
|
|||
|
;; dbg:
|
|||
|
;; dbg (ess-write-to-dribble-buffer
|
|||
|
;; dbg (format "(eval-visibly 2): text[%d]= '%s'\n" (length text) text))
|
|||
|
(while (or (setq txt-gt-0 (> (length text) 0))
|
|||
|
even-empty)
|
|||
|
(setq even-empty nil)
|
|||
|
(if txt-gt-0
|
|||
|
(progn
|
|||
|
(setq pos (string-match "\n\\|$" text))
|
|||
|
(setq com (concat (substring text 0 pos) "\n"))
|
|||
|
(setq text (substring text (min (length text) (1+ pos)))))
|
|||
|
;; else 0-length text
|
|||
|
(setq com "\n"))
|
|||
|
(goto-char (marker-position (process-mark sprocess)))
|
|||
|
(if win (set-window-point win (process-mark sprocess)))
|
|||
|
(when (not invisibly)
|
|||
|
(insert (propertize com 'font-lock-face 'comint-highlight-input)) ;; for consistency with comint :(
|
|||
|
(set-marker (process-mark sprocess) (point)))
|
|||
|
(inferior-ess-mark-as-busy sprocess)
|
|||
|
(process-send-string sprocess com)
|
|||
|
(when (or wait-last-prompt
|
|||
|
(> (length text) 0))
|
|||
|
(ess-wait-for-process sprocess t wait-sec)))
|
|||
|
(if eob (ess-show-buffer (buffer-name sbuffer) nil))
|
|||
|
(goto-char (marker-position (process-mark sprocess)))
|
|||
|
(when win
|
|||
|
(with-selected-window win
|
|||
|
(goto-char (point))
|
|||
|
;; this is crucial to avoid reseting window-point
|
|||
|
(recenter (- -1 scroll-margin))) )))
|
|||
|
|
|||
|
(if (numberp sleep-sec)
|
|||
|
(sleep-for sleep-sec)))); in addition to timeout-ms
|
|||
|
|
|||
|
|
|||
|
;; VS[06-01-2013]: this how far I got in investingating the emacs reseting of
|
|||
|
;; window-point. It really happens out of the blue :(
|
|||
|
|
|||
|
;; (defun test ()
|
|||
|
;; (let* ((cbuffer (get-buffer "*R*"))
|
|||
|
;; (proc (get-buffer-process cbuffer))
|
|||
|
;; (win (get-buffer-window cbuffer t)))
|
|||
|
;; (with-current-buffer cbuffer
|
|||
|
;; (proc-send-test proc win "ls()\n")
|
|||
|
;; (ess-wait-for-process proc t 0.005)
|
|||
|
;; ;; (goto-char (marker-position (process-mark proc)))
|
|||
|
;; ;; (set-window-point win (point))
|
|||
|
;; (proc-send-test proc win "NA\n")
|
|||
|
;; ;; (when win
|
|||
|
;; ;; (set-window-point win (point-max)))
|
|||
|
;; )))
|
|||
|
|
|||
|
|
|||
|
;; (defun proc-send-test (proc win com)
|
|||
|
;; (with-current-buffer (process-buffer proc)
|
|||
|
;; (goto-char (marker-position (process-mark proc)))
|
|||
|
;; (inferior-ess-mark-as-busy proc)
|
|||
|
;; (insert com)
|
|||
|
;; (set-marker (process-mark proc) (point))
|
|||
|
;; (set-window-point win (point))
|
|||
|
;; (process-send-string proc com)
|
|||
|
;; ))
|
|||
|
|
|||
|
;;;*;;; Evaluate only
|
|||
|
|
|||
|
(defvar ess-current-region-overlay
|
|||
|
(let ((overlay (make-overlay (point) (point))))
|
|||
|
(overlay-put overlay 'face 'highlight)
|
|||
|
overlay)
|
|||
|
"The overlay for highlighting currently evaluated region or line.")
|
|||
|
|
|||
|
(defun ess-blink-region (start end)
|
|||
|
(when ess-blink-region
|
|||
|
(move-overlay ess-current-region-overlay start end)
|
|||
|
(run-with-timer ess-blink-delay nil
|
|||
|
(lambda ()
|
|||
|
(delete-overlay ess-current-region-overlay)))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-eval-region (start end toggle &optional message inject)
|
|||
|
"Send the current region to the inferior ESS process.
|
|||
|
With prefix argument toggle the meaning of `ess-eval-visibly';
|
|||
|
this does not apply when using the S-plus GUI, see `ess-eval-region-ddeclient'.
|
|||
|
|
|||
|
If INJECT is non-nil the region will be pre-processed in a
|
|||
|
dialect specific way to include source references"
|
|||
|
|
|||
|
(interactive "r\nP")
|
|||
|
;;(untabify (point-min) (point-max))
|
|||
|
;;(untabify start end); do we really need to save-excursion?
|
|||
|
(ess-force-buffer-current "Process to use: ")
|
|||
|
|
|||
|
(unless ess-local-customize-alist
|
|||
|
;; external applications might call ess-eval-* functions; make it easier for them
|
|||
|
(ess-setq-vars-local (symbol-value (ess-get-process-variable 'ess-local-customize-alist))))
|
|||
|
|
|||
|
(message "Starting evaluation...")
|
|||
|
(setq message (or message "Eval region"))
|
|||
|
|
|||
|
(save-excursion
|
|||
|
;; don't send new lines (avoid screwing the debugger)
|
|||
|
(goto-char start)
|
|||
|
(skip-chars-forward "\n\t ")
|
|||
|
(setq start (point))
|
|||
|
|
|||
|
(unless mark-active
|
|||
|
(ess-blink-region start end))
|
|||
|
|
|||
|
;; don't send new lines at the end (avoid screwing the debugger)
|
|||
|
(goto-char end)
|
|||
|
(skip-chars-backward "\n\t ")
|
|||
|
(setq end (point)))
|
|||
|
|
|||
|
(let* ((proc (get-process ess-local-process-name))
|
|||
|
(visibly (if toggle (not ess-eval-visibly) ess-eval-visibly))
|
|||
|
(dev-p (or ess-developer
|
|||
|
(ess-get-process-variable 'ess-developer)))
|
|||
|
(tb-p (process-get proc 'tracebug)))
|
|||
|
(cond
|
|||
|
(dev-p (ess-developer-send-region proc start end visibly message tb-p))
|
|||
|
(tb-p (ess-tracebug-send-region proc start end visibly message inject))
|
|||
|
(t (ess-send-region proc start end visibly message))))
|
|||
|
|
|||
|
(if (and (fboundp 'deactivate-mark) ess-eval-deactivate-mark)
|
|||
|
(deactivate-mark))
|
|||
|
;; return value
|
|||
|
(list start end))
|
|||
|
|
|||
|
(defun ess-eval-buffer (vis)
|
|||
|
"Send the current buffer to the inferior ESS process.
|
|||
|
Arg has same meaning as for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(ess-eval-region (point-min) (point-max) vis "Eval buffer" 'buffer))
|
|||
|
|
|||
|
(defun ess-eval-buffer-from-beg-to-here (vis)
|
|||
|
(interactive "P")
|
|||
|
(ess-eval-region (point-min) (point) vis "Eval buffer from the beginning
|
|||
|
of the buffer until here, i.e. 'point'"))
|
|||
|
|
|||
|
(defun ess-eval-buffer-from-here-to-end (vis)
|
|||
|
(interactive "P")
|
|||
|
(ess-eval-region (point) (point-max) vis "Eval buffer from here ('point') until
|
|||
|
the end of the buffer"))
|
|||
|
|
|||
|
|
|||
|
(defun ess-eval-function (vis &optional no-error)
|
|||
|
"Send the current function to the inferior ESS process.
|
|||
|
Arg has same meaning as for `ess-eval-region'.
|
|||
|
|
|||
|
If NO-ERROR is non-nil and the function was successfully
|
|||
|
evaluated, return '(beg end) representing the beginning and end
|
|||
|
of the current function, otherwise (in case of an error) return
|
|||
|
nil."
|
|||
|
(interactive "P")
|
|||
|
(ess-force-buffer-current "Process to use: ")
|
|||
|
(save-excursion
|
|||
|
(ignore-errors
|
|||
|
;; evaluation is forward oriented
|
|||
|
(forward-line -1)
|
|||
|
(ess-next-code-line 1))
|
|||
|
(let ((beg-end (ess-end-of-function nil no-error)))
|
|||
|
(if beg-end
|
|||
|
(let* ((beg (nth 0 beg-end))
|
|||
|
(end (nth 1 beg-end))
|
|||
|
(proc (get-process ess-local-process-name))
|
|||
|
(tb-p (process-get proc 'tracebug))
|
|||
|
(dev-p (or ess-developer
|
|||
|
(ess-get-process-variable 'ess-developer)))
|
|||
|
(name (progn (goto-char beg)
|
|||
|
(forward-word) ;;func names starting with . are not recognized??
|
|||
|
(ess-read-object-name-default)))
|
|||
|
(mess (format "Eval function %s"
|
|||
|
(propertize (or name "???")
|
|||
|
'face 'font-lock-function-name-face)))
|
|||
|
(visibly (if vis (not ess-eval-visibly) ess-eval-visibly)))
|
|||
|
|
|||
|
(ess-blink-region beg end)
|
|||
|
(cond
|
|||
|
(dev-p (ess-developer-send-function proc beg end name visibly mess tb-p))
|
|||
|
(tb-p (ess-tracebug-send-function proc beg end visibly mess))
|
|||
|
(t (ess-send-region proc beg end visibly mess)))
|
|||
|
beg-end)
|
|||
|
nil))))
|
|||
|
|
|||
|
|
|||
|
;; This is from Mary Lindstrom <lindstro@Biostat.Wisc.Edu>
|
|||
|
;; 31 Aug 1995 14:11:43 To: S-mode@stat.math.ethz.ch
|
|||
|
(defun ess-eval-paragraph (vis)
|
|||
|
"Send the current paragraph to the inferior ESS process.
|
|||
|
Prefix arg VIS toggles visibility of ess-code as for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(save-excursion
|
|||
|
(forward-paragraph)
|
|||
|
(let ((end (point)))
|
|||
|
(backward-paragraph)
|
|||
|
(ess-eval-region (point) end vis "Eval paragraph"))))
|
|||
|
|
|||
|
;; ;; Experimental - after suggestion from Jenny Brian for an 'eval-multiline'
|
|||
|
;; ;; 'sentence' is too much : almost like 'paragraph'
|
|||
|
;; ;; 'sexp' is close, but too little [when point is inside function call;
|
|||
|
;; ;; it moves all the way to the end - which is fine]
|
|||
|
;; (defun ess-eval-sexp (vis)
|
|||
|
;; "Send the current sexp to the inferior ESS process.
|
|||
|
;; Prefix arg VIS toggles visibility of ess-code as for `ess-eval-region'."
|
|||
|
;; (interactive "P")
|
|||
|
;; (save-excursion
|
|||
|
;; (forward-sexp)
|
|||
|
;; (let ((end (point)))
|
|||
|
;; (backward-sexp)
|
|||
|
;; (ess-eval-region (point) end vis "Eval sexp"))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-eval-function-or-paragraph (vis)
|
|||
|
"Send the current function if \\[point] is inside one, otherwise the current
|
|||
|
paragraph other to the inferior ESS process.
|
|||
|
Prefix arg VIS toggles visibility of ess-code as for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(let ((beg-end (ess-eval-function vis 'no-error)))
|
|||
|
(if (null beg-end) ; not a function
|
|||
|
(ess-eval-paragraph vis))))
|
|||
|
|
|||
|
(defun ess-eval-function-or-paragraph-and-step (vis)
|
|||
|
"Send the current function if \\[point] is inside one, otherwise the current
|
|||
|
paragraph other to the inferior ESS process.
|
|||
|
Prefix arg VIS toggles visibility of ess-code as for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(let ((beg-end (ignore-errors (ess-eval-function vis 'no-error)))) ;; ignore-errors is a hack, ess-eval-function gives stupid errors sometimes
|
|||
|
(if (null beg-end) ; not a function
|
|||
|
(ess-eval-paragraph-and-step vis)
|
|||
|
(goto-char (cadr beg-end))
|
|||
|
(if ess-eval-empty
|
|||
|
(forward-line 1)
|
|||
|
(ess-next-code-line 1)))))
|
|||
|
|
|||
|
(defun ess-eval-region-or-function-or-paragraph (vis)
|
|||
|
"Send the current region if mark is active, if not, send
|
|||
|
function if \\[point] is inside one, otherwise the current
|
|||
|
paragraph.
|
|||
|
|
|||
|
Prefix arg VIS toggles visibility of ess-code as for
|
|||
|
`ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(if (and transient-mark-mode mark-active ;; xemacs doesn't have use-region-p
|
|||
|
(> (region-end) (region-beginning)))
|
|||
|
(ess-eval-region (region-beginning) (region-end) vis)
|
|||
|
(ess-eval-function-or-paragraph vis)))
|
|||
|
|
|||
|
|
|||
|
(defun ess-eval-region-or-function-or-paragraph-and-step (vis)
|
|||
|
"Send the current region if mark is active, if not, send
|
|||
|
function if \\[point] is inside one, otherwise the current
|
|||
|
paragraph. After evaluation step to the next code line or to the
|
|||
|
end of region if region was active.
|
|||
|
|
|||
|
Prefix arg VIS toggles visibility of ess-code as for
|
|||
|
`ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(if (and transient-mark-mode mark-active ;; xemacs doesn't have use-region-p
|
|||
|
(> (region-end) (region-beginning)))
|
|||
|
(let ((end (region-end)))
|
|||
|
(ess-eval-region (region-beginning) end vis)
|
|||
|
(goto-char end))
|
|||
|
(ess-eval-function-or-paragraph-and-step vis)))
|
|||
|
|
|||
|
|
|||
|
(defun ess-eval-line (vis)
|
|||
|
"Send the current line to the inferior ESS process.
|
|||
|
Arg has same meaning as for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(save-excursion
|
|||
|
(end-of-line)
|
|||
|
(let ((end (point)))
|
|||
|
(beginning-of-line)
|
|||
|
(princ (concat "Loading line: " (ess-extract-word-name) " ...") t)
|
|||
|
(ess-eval-region (point) end vis "Eval line"))))
|
|||
|
|
|||
|
|
|||
|
|
|||
|
(defun ess-next-code-line (&optional arg skip-to-eob)
|
|||
|
"Move ARG lines of code forward (backward if ARG is negative).
|
|||
|
Skips past all empty and comment lines. Default for ARG is 1.
|
|||
|
Don't skip the last empty and comment lines in the buffer unless
|
|||
|
SKIP-TO-EOB is non-nil.
|
|||
|
|
|||
|
On success, return 0. Otherwise, go as far as possible and return -1."
|
|||
|
(interactive "p")
|
|||
|
(or arg (setq arg 1))
|
|||
|
(beginning-of-line)
|
|||
|
(let ((pos (point))
|
|||
|
(n 0)
|
|||
|
(inc (if (> arg 0) 1 -1)))
|
|||
|
(while (and (/= arg 0) (= n 0))
|
|||
|
(setq n (forward-line inc)); n=0 is success
|
|||
|
(if (not (fboundp 'comment-beginning))
|
|||
|
(while (and (= n 0)
|
|||
|
(looking-at "\\s-*\\($\\|\\s<\\)"))
|
|||
|
(setq n (forward-line inc)))
|
|||
|
(comment-beginning)
|
|||
|
(beginning-of-line)
|
|||
|
(forward-comment (* inc (buffer-size))) ;; as suggested in info file
|
|||
|
)
|
|||
|
(if (or skip-to-eob
|
|||
|
(not (looking-at ess-no-skip-regexp))) ;; don't go to eob or whatever
|
|||
|
(setq arg (- arg inc))
|
|||
|
(goto-char pos)
|
|||
|
(setq arg 0)
|
|||
|
(forward-line 1));; stop at next empty line
|
|||
|
(setq pos (point)))
|
|||
|
(goto-char pos)
|
|||
|
n))
|
|||
|
|
|||
|
(defun ess-eval-line-and-step (&optional simple-next even-empty invisibly)
|
|||
|
"Evaluate the current line visibly and step to the \"next\" line.
|
|||
|
If SIMPLE-NEXT is non-nil, possibly via prefix arg, first skip
|
|||
|
empty and commented lines. If 2nd arg EVEN-EMPTY [prefix as
|
|||
|
well], also send empty lines. When the variable `ess-eval-empty'
|
|||
|
is non-nil both SIMPLE-NEXT and EVEN-EMPTY are interpreted as
|
|||
|
true."
|
|||
|
;; From an idea by Rod Ball (rod@marcam.dsir.govt.nz)
|
|||
|
(interactive "P\nP"); prefix sets BOTH !
|
|||
|
(ess-force-buffer-current "Process to load into: ")
|
|||
|
(save-excursion
|
|||
|
(end-of-line)
|
|||
|
(let ((end (point)))
|
|||
|
(beginning-of-line)
|
|||
|
;; go to end of process buffer so user can see result
|
|||
|
(ess-eval-linewise (buffer-substring (point) end)
|
|||
|
invisibly 'eob (or even-empty ess-eval-empty))))
|
|||
|
(if (or simple-next ess-eval-empty even-empty)
|
|||
|
(forward-line 1)
|
|||
|
(ess-next-code-line 1)))
|
|||
|
|
|||
|
(defun ess-eval-region-or-line-and-step (&optional vis)
|
|||
|
"Evaluate region if there is an active one, otherwise the current line.
|
|||
|
|
|||
|
Prefix arg VIS toggles visibility of ess-code when evaluating
|
|||
|
the region (as for `ess-eval-region') and has no effect for
|
|||
|
evaluation of the line.
|
|||
|
"
|
|||
|
(interactive "P")
|
|||
|
(if (and transient-mark-mode mark-active ;; xemacs doesn't have use-region-p
|
|||
|
(> (region-end) (region-beginning)))
|
|||
|
(ess-eval-region (region-beginning) (region-end) vis)
|
|||
|
(ess-eval-line-and-step)))
|
|||
|
|
|||
|
(defun ess-eval-line-and-step-invisibly ()
|
|||
|
"Evaluate the current line invisibly and step to the next line.
|
|||
|
Evaluate all comments and empty lines."
|
|||
|
(interactive)
|
|||
|
(ess-eval-line-and-step t t t))
|
|||
|
|
|||
|
;; goes to the real front, in case you do double function definition
|
|||
|
;; 29-Jul-92 -FER
|
|||
|
;; don't know why David changed it.
|
|||
|
|
|||
|
;; FER's versions don't work properly with nested functions. Replaced
|
|||
|
;; mine. DMS 16 Nov 92
|
|||
|
|
|||
|
;;;*;;; Evaluate and switch to S
|
|||
|
|
|||
|
(defun ess-eval-region-and-go (start end vis)
|
|||
|
"Send the current region to the inferior S and switch to the process buffer.
|
|||
|
Arg has same meaning as for `ess-eval-region'."
|
|||
|
(interactive "r\nP")
|
|||
|
(ess-eval-region start end vis)
|
|||
|
(ess-switch-to-ESS t))
|
|||
|
|
|||
|
(defun ess-eval-buffer-and-go (vis)
|
|||
|
"Send the current buffer to the inferior S and switch to the process buffer.
|
|||
|
Arg has same meaning as for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(ess-eval-buffer vis)
|
|||
|
(ess-switch-to-ESS t))
|
|||
|
|
|||
|
(defun ess-eval-function-and-go (vis)
|
|||
|
"Send the current function to the inferior ESS process and switch to
|
|||
|
the process buffer. Arg has same meaning as for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(ess-eval-function vis)
|
|||
|
(ess-switch-to-ESS t))
|
|||
|
|
|||
|
(defun ess-eval-line-and-go (vis)
|
|||
|
"Send the current line to the inferior ESS process and switch to the
|
|||
|
process buffer. Arg has same meaning as for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(ess-eval-line vis)
|
|||
|
(ess-switch-to-ESS t))
|
|||
|
|
|||
|
(defun ess-eval-paragraph-and-go (vis)
|
|||
|
"Send the current paragraph to the inferior ESS process and switch to the
|
|||
|
process buffer. Arg has same meaning as for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(ess-eval-paragraph vis)
|
|||
|
(ess-switch-to-ESS t))
|
|||
|
|
|||
|
(defun ess-eval-paragraph-and-step (vis)
|
|||
|
"Send the current paragraph to the inferior ESS process and
|
|||
|
move forward to the first line after the paragraph. If not
|
|||
|
inside a paragraph, evaluate next one. Arg has same meaning as
|
|||
|
for `ess-eval-region'."
|
|||
|
(interactive "P")
|
|||
|
(let ((beg-end (ess-eval-paragraph vis)))
|
|||
|
(goto-char (cadr beg-end))
|
|||
|
(if ess-eval-empty
|
|||
|
(forward-line 1)
|
|||
|
(ess-next-code-line 1))))
|
|||
|
|
|||
|
;;; Related to the ess-eval-* commands, there are the ess-load
|
|||
|
;;; commands. Need to add appropriate stuff...
|
|||
|
|
|||
|
|
|||
|
(defun ess-load-file (&optional filename)
|
|||
|
"Load a source file into an inferior ESS process."
|
|||
|
(interactive (list
|
|||
|
(or
|
|||
|
(and (memq major-mode '(ess-mode ess-julia-mode))
|
|||
|
(buffer-file-name))
|
|||
|
(expand-file-name
|
|||
|
(read-file-name "Load source file: " nil nil t)))))
|
|||
|
(ess-force-buffer-current "Process to load into: ")
|
|||
|
(if (or ess-developer
|
|||
|
(ess-get-process-variable 'ess-developer))
|
|||
|
(ess-developer-source-current-file filename)
|
|||
|
(let ((filename (if (and (fboundp 'tramp-tramp-file-p)
|
|||
|
(tramp-tramp-file-p filename))
|
|||
|
(tramp-file-name-localname (tramp-dissect-file-name filename))
|
|||
|
filename)))
|
|||
|
(if ess-microsoft-p
|
|||
|
(setq filename (ess-replace-in-string filename "[\\]" "/")))
|
|||
|
(if (fboundp (ess-process-get 'source-file-function))
|
|||
|
(funcall (ess-process-get 'source-file-function) filename)
|
|||
|
(let ((source-buffer (get-file-buffer filename)))
|
|||
|
(if (ess-check-source filename)
|
|||
|
(error "Buffer %s has not been saved" (buffer-name source-buffer)))
|
|||
|
;; else
|
|||
|
(if (ess-ddeclient-p)
|
|||
|
(ess-load-file-ddeclient filename)
|
|||
|
|
|||
|
;; else: "normal", non-DDE behavior:
|
|||
|
;; Find the process to load into
|
|||
|
(if source-buffer
|
|||
|
(with-current-buffer source-buffer
|
|||
|
(ess-force-buffer-current "Process to load into: ")
|
|||
|
(ess-check-modifications)))
|
|||
|
(let ((errbuffer (ess-create-temp-buffer ess-error-buffer-name))
|
|||
|
error-occurred nomessage)
|
|||
|
(ess-eval-linewise (format ess-load-command filename))
|
|||
|
)))))))
|
|||
|
|
|||
|
;; C-c C-l *used to* eval code:
|
|||
|
(defun ess-msg-and-comint-dynamic-list-input-ring ()
|
|||
|
"Display a list of recent inputs entered into the current buffer."
|
|||
|
(interactive)
|
|||
|
(message "C-c C-l no longer loads a source file in [iESS], rather use C-c M-l instead")
|
|||
|
(comint-dynamic-list-input-ring))
|
|||
|
|
|||
|
; Inferior S mode
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
;;;; In this section:
|
|||
|
;;;;
|
|||
|
;;;; * The major mode inferior-ess-mode
|
|||
|
;;;; * Process handling code
|
|||
|
;;;; * Completion code
|
|||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|||
|
;;*;; Major mode definition
|
|||
|
|
|||
|
(defvar inferior-ess-mode-map
|
|||
|
(let ((map (make-sparse-keymap)))
|
|||
|
(set-keymap-parent map comint-mode-map)
|
|||
|
|
|||
|
(define-key map "\C-y" 'ess-yank)
|
|||
|
;; Use syntax valid *both* for GNU emacs and XEmacs :
|
|||
|
(define-key map "\r" 'inferior-ess-send-input)
|
|||
|
(define-key map "\C-a" 'comint-bol)
|
|||
|
|
|||
|
;; 2010-06-03 SJE
|
|||
|
;; disabled this in favour of ess-dirs. Martin was not sure why this
|
|||
|
;; key was defined anyway in this mode.
|
|||
|
;;(define-key map "\M-\r" 'ess-transcript-send-command-and-move)
|
|||
|
(define-key map "\C-c\M-l" 'ess-load-file);; no longer overwrites C-c C-l;
|
|||
|
;; but for now the user deserves a message:
|
|||
|
(define-key map "\C-c\C-l" 'ess-msg-and-comint-dynamic-list-input-ring)
|
|||
|
(define-key map "\C-c`" 'ess-show-traceback)
|
|||
|
(define-key map [(control ?c) ?~] 'ess-show-call-stack)
|
|||
|
(define-key map "\C-c\C-d" 'ess-dump-object-into-edit-buffer)
|
|||
|
(define-key map "\C-c\C-v" 'ess-display-help-on-object)
|
|||
|
(define-key map "\C-c\C-q" 'ess-quit)
|
|||
|
(define-key map "\C-c\C-s" 'ess-execute-search)
|
|||
|
(define-key map "\C-c\C-x" 'ess-execute-objects)
|
|||
|
(define-key map "\C-c\034" 'ess-abort) ; \C-c\C-backslash
|
|||
|
(define-key map "\C-c\C-z" 'ess-switch-to-inferior-or-script-buffer) ; mask comint map
|
|||
|
(define-key map "\C-d" 'delete-char) ; EOF no good in S
|
|||
|
(if (and (featurep 'emacs) (>= emacs-major-version 24))
|
|||
|
(define-key map "\t" 'completion-at-point)
|
|||
|
(define-key map "\t" 'comint-dynamic-complete)
|
|||
|
(define-key map "\M-\t" 'comint-dynamic-complete))
|
|||
|
(define-key map "\C-c\t" 'ess-complete-object-name-deprecated)
|
|||
|
(define-key map "\M-?" 'ess-list-object-completions)
|
|||
|
(define-key map "\C-c\C-k" 'ess-request-a-process)
|
|||
|
(define-key map "," 'ess-smart-comma)
|
|||
|
|
|||
|
(define-key map "\C-c\C-d" 'ess-doc-map)
|
|||
|
(define-key map "\C-c\C-e" 'ess-extra-map)
|
|||
|
(define-key map "\C-c\C-t" 'ess-dev-map)
|
|||
|
map)
|
|||
|
"Keymap for `inferior-ess' mode.")
|
|||
|
|
|||
|
(easy-menu-define
|
|||
|
inferior-ess-mode-menu inferior-ess-mode-map
|
|||
|
"Menu for use in Inferior S mode"
|
|||
|
'("iESS"
|
|||
|
["What is this? (beta)" ess-mouse-me t]
|
|||
|
["Quit" ess-quit t]
|
|||
|
;; ["Send and move" ess-transcript-send-command-and-move t]
|
|||
|
["Copy command" comint-copy-old-input t]
|
|||
|
["Send command" inferior-ess-send-input t]
|
|||
|
["Switch to Script Buffer" ess-switch-to-inferior-or-script-buffer t]
|
|||
|
["Get help on S object" ess-display-help-on-object t]
|
|||
|
"------"
|
|||
|
("Process"
|
|||
|
["Process Echoes" (lambda () (interactive)
|
|||
|
(setq comint-process-echoes (not comint-process-echoes)))
|
|||
|
:active t
|
|||
|
:style toggle
|
|||
|
:selected comint-process-echoes]
|
|||
|
("Eval visibly "
|
|||
|
:filter ess--generate-eval-visibly-submenu ))
|
|||
|
"------"
|
|||
|
("Utils"
|
|||
|
;; need a toggle switch for above, AJR.
|
|||
|
["Attach directory" ess-execute-attach t]
|
|||
|
["Display object list" ess-execute-objects t]
|
|||
|
["Display search list" ess-execute-search t]
|
|||
|
["Edit S Object" ess-dump-object-into-edit-buffer t]
|
|||
|
["Enter S command" ess-execute t]
|
|||
|
["Jump to Error" ess-parse-errors t]
|
|||
|
["Load source file" ess-load-file t]
|
|||
|
["Resynch S completions" ess-resynch t]
|
|||
|
["Recreate R and S versions known to ESS" (ess-r-s-versions-creation+menu) t]
|
|||
|
)
|
|||
|
"------"
|
|||
|
("start-dev" :visible nil); <-- ??
|
|||
|
("end-dev" :visible nil)
|
|||
|
"------"
|
|||
|
("Font Lock"
|
|||
|
:active inferior-ess-font-lock-keywords
|
|||
|
:filter ess--generate-font-lock-submenu)
|
|||
|
"------"
|
|||
|
["Describe" describe-mode t]
|
|||
|
["Send bug report" ess-submit-bug-report t]
|
|||
|
["About" (ess-goto-info "Entering Commands") t]
|
|||
|
))
|
|||
|
|
|||
|
|
|||
|
|
|||
|
(defun inferior-ess-mode-xemacs-menu ()
|
|||
|
"Hook to install `ess-mode' menu for XEmacs (w/ easymenu)."
|
|||
|
(if 'inferior-ess-mode
|
|||
|
(easy-menu-add inferior-ess-mode-menu)
|
|||
|
(easy-menu-remove inferior-ess-mode-menu)))
|
|||
|
|
|||
|
(if (string-match "XEmacs" emacs-version)
|
|||
|
(add-hook 'inferior-ess-mode-hook 'inferior-ess-mode-xemacs-menu))
|
|||
|
|
|||
|
(defvar ess-mode-minibuffer-map
|
|||
|
(let ((map (make-sparse-keymap)))
|
|||
|
(set-keymap-parent map minibuffer-local-map)
|
|||
|
|
|||
|
(define-key map "\t" 'ess-complete-object-name)
|
|||
|
(define-key map "\C-\M-i" 'ess-complete-object-name) ;; doesn't work:(
|
|||
|
(define-key map "\C-c\C-s" 'ess-execute-search)
|
|||
|
(define-key map "\C-c\C-x" 'ess-execute-objects)
|
|||
|
map)
|
|||
|
"Keymap used in `ess-execute'")
|
|||
|
|
|||
|
(defun inferior-ess-mode ()
|
|||
|
"Major mode for interacting with an inferior ESS process.
|
|||
|
Runs an S interactive job as a subprocess of Emacs, with I/O through an
|
|||
|
Emacs buffer. Variable `inferior-ess-program' controls which S
|
|||
|
is run.
|
|||
|
|
|||
|
Commands are sent to the ESS process by typing them, and pressing
|
|||
|
\\[inferior-ess-send-input]. Pressing \\[complete-dynamic-complete]
|
|||
|
completes known object names or filenames, as appropriate. Other
|
|||
|
keybindings for this mode are:
|
|||
|
|
|||
|
\\{inferior-ess-mode-map}
|
|||
|
|
|||
|
When editing S objects, the use of \\[ess-load-file] is advocated.
|
|||
|
`ess-load-file' keeps source files (if `ess-keep-dump-files' is non-nil) in
|
|||
|
the directory specified by `ess-source-directory', with the
|
|||
|
filename chosen according to `ess-dump-filename-template'. When a file is
|
|||
|
loaded, `ess-mode' parses error messages and jumps to the appropriate file
|
|||
|
if errors occur. The ess-eval- commands do not do this.
|
|||
|
|
|||
|
Customization: Entry to this mode runs the hooks on `comint-mode-hook' and
|
|||
|
`inferior-ess-mode-hook' (in that order).
|
|||
|
|
|||
|
You can send text to the inferior ESS process from other buffers containing
|
|||
|
S source. The key bindings of these commands can be found by typing
|
|||
|
C-h m (help for mode) in the other buffers.
|
|||
|
`ess-eval-region' sends the current region to the ESS process.
|
|||
|
`ess-eval-buffer' sends the current buffer to the ESS process.
|
|||
|
`ess-eval-function' sends the current function to the ESS process.
|
|||
|
`ess-eval-line' sends the current line to the ESS process.
|
|||
|
`ess-beginning-of-function' and `ess-end-of-function' move the point to
|
|||
|
the beginning and end of the current S function.
|
|||
|
`ess-switch-to-ESS' switches the current buffer to the ESS process buffer.
|
|||
|
`ess-switch-to-end-of-ESS' switches the current buffer to the ESS process
|
|||
|
buffer and puts point at the end of it.
|
|||
|
|
|||
|
`ess-eval-region-and-go', `ess-eval-buffer-and-go',
|
|||
|
`ess-eval-function-and-go', and `ess-eval-line-and-go' switch to the S
|
|||
|
process buffer after sending their text.
|
|||
|
`ess-dump-object-into-edit-buffer' moves an S object into a temporary file
|
|||
|
and buffer for editing
|
|||
|
`ess-load-file' sources a file of commands to the ESS process.
|
|||
|
|
|||
|
Commands:
|
|||
|
Return after the end of the process' output sends the text from the
|
|||
|
end of process to point.
|
|||
|
Return before the end of the process' output copies the sexp ending at point
|
|||
|
to the end of the process' output, and sends it.
|
|||
|
Delete converts tabs to spaces as it moves back.
|
|||
|
C-M-q does Tab on each line starting within following expression.
|
|||
|
Paragraphs are separated only by blank lines. Crosshatches start comments.
|
|||
|
If you accidentally suspend your process, use \\[comint-continue-subjob]
|
|||
|
to continue it."
|
|||
|
(interactive)
|
|||
|
|
|||
|
(comint-mode)
|
|||
|
|
|||
|
(set (make-local-variable 'comint-input-sender) 'inferior-ess-input-sender)
|
|||
|
(set (make-local-variable 'process-connection-type) t)
|
|||
|
;; initialize all custom vars:
|
|||
|
(ess-setq-vars-local ess-customize-alist) ; (current-buffer))
|
|||
|
|
|||
|
;; If comint-process-echoes is t inferior-ess-input-sender
|
|||
|
;; recopies the input, otherwise not. VS[03-09-2012]: should be in customize-alist
|
|||
|
(set (make-local-variable 'comint-process-echoes)
|
|||
|
(not (member ess-language '("SAS" "XLS" "OMG" "julia")))) ;; these don't echo
|
|||
|
|
|||
|
(when (and (member ess-dialect '("R")) ;; S+ echoes!!
|
|||
|
(not (eq ess-eval-visibly t)))
|
|||
|
;; when 'nowait or nil, don't wait for process
|
|||
|
(setq comint-process-echoes nil))
|
|||
|
|
|||
|
(when comint-use-prompt-regexp ;; why comint is not setting this? bug?
|
|||
|
(set (make-local-variable 'inhibit-field-text-motion) t))
|
|||
|
|
|||
|
(unless inferior-ess-prompt ;; build when unset
|
|||
|
(setq inferior-ess-prompt
|
|||
|
(concat "\\("
|
|||
|
inferior-ess-primary-prompt
|
|||
|
(when inferior-ess-secondary-prompt "\\|")
|
|||
|
inferior-ess-secondary-prompt
|
|||
|
"\\)")))
|
|||
|
(setq comint-prompt-regexp (concat "^" inferior-ess-prompt))
|
|||
|
(setq comint-get-old-input 'inferior-ess-get-old-input) ;; todo: this is R specific
|
|||
|
(add-hook 'comint-input-filter-functions 'ess-search-path-tracker nil 'local) ;; R and S specific
|
|||
|
|
|||
|
(setq major-mode 'inferior-ess-mode)
|
|||
|
(setq mode-name "iESS") ;(concat "iESS:" ess-dialect))
|
|||
|
(setq mode-line-process
|
|||
|
'(" ["
|
|||
|
ess--mode-line-process-indicator
|
|||
|
ess--local-mode-line-process-indicator
|
|||
|
"]: %s"))
|
|||
|
(use-local-map inferior-ess-mode-map)
|
|||
|
(if ess-mode-syntax-table
|
|||
|
(set-syntax-table ess-mode-syntax-table)
|
|||
|
;; FIXME: need to do something if not set! Get from the proper place!
|
|||
|
)
|
|||
|
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(i-ess 1): buf=%s, lang=%s, comint..echo=%s, comint..sender=%s,\n"
|
|||
|
(current-buffer) ess-language
|
|||
|
comint-process-echoes comint-input-sender))
|
|||
|
|
|||
|
(when (string= ess-language "S") ;; todo: what is this doing here?
|
|||
|
(local-set-key "\M-\r" 'ess-dirs))
|
|||
|
|
|||
|
;; Font-lock support
|
|||
|
;; AJR: This (the following local-var is already the case!
|
|||
|
;; KH sez: only in XEmacs :-(. (& Emacs 22.1, SJE).
|
|||
|
(when inferior-ess-font-lock-keywords ;; new system
|
|||
|
(setq inferior-ess-font-lock-defaults
|
|||
|
(ess--extract-default-fl-keywords inferior-ess-font-lock-keywords)))
|
|||
|
|
|||
|
(set (make-local-variable 'font-lock-defaults)
|
|||
|
'(inferior-ess-font-lock-defaults nil nil ((?\. . "w") (?\_ . "w") (?' . "."))))
|
|||
|
|
|||
|
;; SJE 2007-06-28: Emacs 22.1 has a bug in that comint-mode will set
|
|||
|
;; this variable to t, when we need it to be nil. The Emacs 22
|
|||
|
;; solution to this bug is to use define-derived-mode to derive
|
|||
|
;; inferior-ess-mode from comint-mode. Not sure if we can go down
|
|||
|
;; that route yet. I've used the when condition so that if the var
|
|||
|
;; is nil, don't bother setting it -- as setting it will make a new
|
|||
|
;; local var.
|
|||
|
(when font-lock-keywords-only
|
|||
|
(setq font-lock-keywords-only nil))
|
|||
|
|
|||
|
;;; Completion support ----------------
|
|||
|
|
|||
|
;; SJE: comint-dynamic-complete-functions is regarded as a hook, rather
|
|||
|
;; than a regular variable. Note order of completion (thanks David Brahm):
|
|||
|
|
|||
|
(if (and (featurep 'emacs ) (>= emacs-major-version 24))
|
|||
|
(progn
|
|||
|
(remove-hook 'completion-at-point-functions 'comint-completion-at-point t) ;; reset the thook
|
|||
|
(add-hook 'completion-at-point-functions 'comint-c-a-p-replace-by-expanded-history nil 'local)
|
|||
|
(add-hook 'completion-at-point-functions 'ess-filename-completion nil 'local))
|
|||
|
(add-hook 'comint-dynamic-complete-functions
|
|||
|
'ess-complete-filename 'append 'local)
|
|||
|
(add-hook 'comint-dynamic-complete-functions ;; only for R, is it ok?
|
|||
|
'ess-complete-object-name 'append 'local)
|
|||
|
(add-hook 'comint-dynamic-complete-functions
|
|||
|
'comint-replace-by-expanded-history 'append 'local)
|
|||
|
|
|||
|
;; When a hook is buffer-local, the dummy function `t' is added to
|
|||
|
;; indicate that the functions in the global value of the hook
|
|||
|
;; should also be run. SJE: I have removed this, as I think it
|
|||
|
;; interferes with our normal completion.
|
|||
|
(remove-hook 'comint-dynamic-complete-functions 't 'local))
|
|||
|
|
|||
|
;; (setq comint-completion-addsuffix nil) ; To avoid spaces after filenames
|
|||
|
;; KH: next 2 lines solve.
|
|||
|
(set (make-local-variable 'comint-completion-addsuffix)
|
|||
|
(cons "/" ""))
|
|||
|
|
|||
|
(setq comint-input-autoexpand t) ; Only for completion, not on input.
|
|||
|
|
|||
|
;; timers
|
|||
|
(add-hook 'ess-idle-timer-functions 'ess-cache-search-list nil 'local)
|
|||
|
(add-hook 'ess-idle-timer-functions 'ess-synchronize-dirs nil 'local)
|
|||
|
|
|||
|
;;; Keep <tabs> out of the code.
|
|||
|
(set (make-local-variable 'indent-tabs-mode) nil)
|
|||
|
|
|||
|
(set (make-local-variable 'paragraph-start)
|
|||
|
(concat inferior-ess-primary-prompt "\\|\^L"))
|
|||
|
(set (make-local-variable 'paragraph-separate) "\^L")
|
|||
|
|
|||
|
;; SJE Tue 28 Dec 2004: do not attempt to load object name db.
|
|||
|
;; (ess-load-object-name-db-file)
|
|||
|
;; (sleep-for 0.5)
|
|||
|
(make-local-variable 'kill-buffer-hook)
|
|||
|
(add-hook 'kill-buffer-hook 'ess-kill-buffer-function)
|
|||
|
(run-hooks 'inferior-ess-mode-hook)
|
|||
|
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(i-ess end): buf=%s, lang=%s, comint..echo=%s, comint..sender=%s,\n"
|
|||
|
(current-buffer) ess-language
|
|||
|
comint-process-echoes comint-input-sender))
|
|||
|
|
|||
|
(message
|
|||
|
(concat (substitute-command-keys
|
|||
|
"Type \\[describe-mode] for help on ESS version ")
|
|||
|
ess-version)))
|
|||
|
|
|||
|
;;*;; Commands used exclusively in inferior-ess-mode
|
|||
|
|
|||
|
;;;*;;; Main user commands
|
|||
|
|
|||
|
(defun inferior-ess-input-sender (proc string)
|
|||
|
(inferior-ess--interrupt-subjob-maybe proc)
|
|||
|
(let ((comint-input-filter-functions nil)) ; comint runs them, don't run twise.
|
|||
|
(if comint-process-echoes
|
|||
|
(ess-eval-linewise string nil nil ess-eval-empty)
|
|||
|
(ess-send-string proc string))))
|
|||
|
|
|||
|
|
|||
|
(defvar ess-help-arg-regexp "\\(['\"]?\\)\\([^,=)'\"]*\\)\\1"
|
|||
|
"Reg(ular) Ex(pression) of help(.) arguments. MUST: 2nd \\(.\\) = arg.")
|
|||
|
(defconst inferior-R--input-help (format "^ *help *(%s)" ess-help-arg-regexp))
|
|||
|
;; (defconst inferior-R-2-input-help (format "^ *\\? *%s" ess-help-arg-regexp))
|
|||
|
(defconst inferior-R--input-?-help-regexp
|
|||
|
"^ *\\(?:\\(?1:[a-zA-Z ]*?\\?\\{1,2\\}\\) *\\(?2:.+\\)\\)")
|
|||
|
(defconst inferior-R--page-regexp (format "^ *page *(%s)" ess-help-arg-regexp))
|
|||
|
|
|||
|
(defun ess-R--sanitize-help-topic (string)
|
|||
|
;; enclose help topics into `` to avoid ?while ?if etc hangs
|
|||
|
(if (string-match "\\([^:]*:+\\)\\(.*\\)$" string) ; treat foo::bar corectly
|
|||
|
(format "%s`%s`" (match-string 1 string) (match-string 2 string))
|
|||
|
(format "`%s`" string)))
|
|||
|
|
|||
|
(defun inferior-R-input-sender (proc string)
|
|||
|
(save-current-buffer
|
|||
|
(let ((help-match (and (string-match inferior-R--input-help string)
|
|||
|
(match-string 2 string)))
|
|||
|
(help-?-match (and (string-match inferior-R--input-?-help-regexp string)
|
|||
|
string))
|
|||
|
(page-match (and (string-match inferior-R--page-regexp string)
|
|||
|
(match-string 2 string))))
|
|||
|
(cond (help-match
|
|||
|
(ess-display-help-on-object help-match)
|
|||
|
(process-send-string proc "\n"))
|
|||
|
(help-?-match
|
|||
|
(if (string-match "\\?\\?\\(.+\\)" help-?-match)
|
|||
|
(ess--display-indexed-help-page (concat help-?-match "\n")
|
|||
|
"^\\([^ \t\n]+::[^ \t\n]+\\)[ \t\n]+"
|
|||
|
(format "*ess-apropos[%s](%s)*"
|
|||
|
ess-current-process-name (match-string 1 help-?-match))
|
|||
|
'appropos)
|
|||
|
(if (string-match "^ *\\? *\\([^:]+\\)$" help-?-match) ; help(foo::bar) doesn't work
|
|||
|
(ess-display-help-on-object (match-string 1 help-?-match))
|
|||
|
;; anything else we send to process almost unchanged
|
|||
|
(let ((help-?-match (and (string-match inferior-R--input-?-help-regexp string)
|
|||
|
(format "%s%s" (match-string 1 string)
|
|||
|
(ess-R--sanitize-help-topic (match-string 2 string))))))
|
|||
|
(ess-display-help-on-object help-?-match "%s\n"))))
|
|||
|
(process-send-string proc "\n"))
|
|||
|
(page-match
|
|||
|
(switch-to-buffer-other-window
|
|||
|
(ess-command (concat page-match "\n")
|
|||
|
(get-buffer-create (concat page-match ".rt"))))
|
|||
|
(R-transcript-mode)
|
|||
|
(process-send-string proc "\n"))
|
|||
|
|
|||
|
(t ;; normal command
|
|||
|
(inferior-ess-input-sender proc string))))))
|
|||
|
|
|||
|
(defun inferior-ess-send-input ()
|
|||
|
"Sends the command on the current line to the ESS process."
|
|||
|
(interactive)
|
|||
|
(run-hooks 'ess-send-input-hook)
|
|||
|
;; (let ((proc (get-buffer-process (current-buffer))))
|
|||
|
;; (if (not proc)
|
|||
|
;; (user-error "Current buffer has no process")
|
|||
|
;; (let ((comint-process-echoes (or comint-process-echoes
|
|||
|
;; (< (point) (marker-position (process-mark proc))))))
|
|||
|
;; (comint-send-input))))
|
|||
|
(comint-send-input)
|
|||
|
(setq ess-object-list nil)) ;; Will be reconstructed from cache if needs be
|
|||
|
|
|||
|
(defun inferior-ess--goto-input-start:field ()
|
|||
|
"Move point to the begining of input skiping all continuation lines.
|
|||
|
If in the output field, goes to the begining of previous input
|
|||
|
field.
|
|||
|
Note: inferior-ess-secondary-prompt should match exactly.
|
|||
|
"
|
|||
|
(goto-char (field-beginning))
|
|||
|
;; move to the begining of non-output field
|
|||
|
(while (and (not (= (point) (point-min)))
|
|||
|
(eq (field-at-pos (point)) 'output))
|
|||
|
(goto-char (field-beginning nil t)))
|
|||
|
;; skip all secondary prompts
|
|||
|
(let ((pos (field-beginning (point) t))
|
|||
|
(secondary-prompt (concat "^" inferior-ess-secondary-prompt)))
|
|||
|
(while (and pos
|
|||
|
(if (eq (get-text-property pos 'field) 'output)
|
|||
|
(string-match secondary-prompt (field-string-no-properties pos))
|
|||
|
t))
|
|||
|
(goto-char pos)
|
|||
|
(setq pos (previous-single-property-change pos 'field)))))
|
|||
|
|
|||
|
(defun inferior-ess--goto-input-end:field ()
|
|||
|
"Move point to the end of input skiping all continuation lines.
|
|||
|
If in the output field, goes to the begining of previous input field.
|
|||
|
|
|||
|
NOTE: to be used only with fields, see `comint-use-prompt-regexp'.
|
|||
|
" ;; this func is not used but might be useful some day
|
|||
|
(goto-char (field-end))
|
|||
|
(let ((pos (point))
|
|||
|
(secondary-prompt (concat "^" inferior-ess-secondary-prompt)))
|
|||
|
(while (and pos
|
|||
|
(if (eq (get-text-property pos 'field) 'output)
|
|||
|
(string-match secondary-prompt (field-string-no-properties pos))
|
|||
|
t))
|
|||
|
(goto-char pos)
|
|||
|
(setq pos (next-single-property-change pos 'field)))))
|
|||
|
|
|||
|
(defun inferior-ess--get-old-input:field ()
|
|||
|
"Return the ESS command surrounding point (use with fields)."
|
|||
|
(save-excursion
|
|||
|
(if (eq (field-at-pos (point)) 'output)
|
|||
|
(if (called-interactively-p 'any)
|
|||
|
(error "No command on this line")
|
|||
|
;; else, just return ""
|
|||
|
"")
|
|||
|
(inferior-ess--goto-input-start:field)
|
|||
|
(let ((command (field-string-no-properties (point)))
|
|||
|
(pos (next-single-property-change (point) 'field ))
|
|||
|
(secondary-prompt (concat "^" inferior-ess-secondary-prompt)))
|
|||
|
(while (and pos
|
|||
|
(cond
|
|||
|
((eq (get-text-property pos 'field) 'input)
|
|||
|
(setq command (concat command "\n" (field-string-no-properties pos))))
|
|||
|
((eq (get-text-property pos 'field) 'output)
|
|||
|
(string-match secondary-prompt (field-string-no-properties pos)))
|
|||
|
(t)));; just skip if unknown
|
|||
|
(setq pos (next-single-property-change pos 'field)))
|
|||
|
command))))
|
|||
|
|
|||
|
;; todo: error when entering a multiline function
|
|||
|
;; check.integer <- function(N){
|
|||
|
;; is.integer(N) | !length(grep("[^[:digit:]]", as.character(N)))
|
|||
|
;; }
|
|||
|
(defun inferior-ess--goto-input-start:regexp ()
|
|||
|
"Move point to the begining of input skiping all continuation lines.
|
|||
|
If in the output field, goes to the begining of previous input.
|
|||
|
"
|
|||
|
(beginning-of-line)
|
|||
|
(unless (looking-at inferior-ess-prompt)
|
|||
|
(re-search-backward (concat "^" inferior-ess-prompt)))
|
|||
|
;; at bol
|
|||
|
(when (and inferior-ess-secondary-prompt
|
|||
|
(looking-at inferior-ess-secondary-prompt))
|
|||
|
(while (and (> (forward-line -1) -1)
|
|||
|
(looking-at inferior-ess-secondary-prompt))))
|
|||
|
(unless (looking-at inferior-ess-prompt)
|
|||
|
(ess-error "Beggining of input not found"))
|
|||
|
(comint-skip-prompt))
|
|||
|
|
|||
|
(defun inferior-ess--get-old-input:regexp ()
|
|||
|
"Return the ESS command surrounding point (use regexp)."
|
|||
|
;;VS[03-09-2012]: This should not rise errors!! Troubles comint-interrupt-subjob
|
|||
|
(save-excursion
|
|||
|
(let* ((inhibit-field-text-motion t)
|
|||
|
command)
|
|||
|
(beginning-of-line)
|
|||
|
(when (and inferior-ess-secondary-prompt
|
|||
|
(looking-at inferior-ess-secondary-prompt))
|
|||
|
(inferior-ess--goto-input-start:regexp))
|
|||
|
(beginning-of-line)
|
|||
|
(if (looking-at inferior-ess-prompt) ; cust.var, might not include sec-prompt
|
|||
|
(progn
|
|||
|
(comint-skip-prompt)
|
|||
|
(setq command (buffer-substring-no-properties (point) (point-at-eol)))
|
|||
|
(when inferior-ess-secondary-prompt
|
|||
|
(while (progn (forward-line 1)
|
|||
|
(looking-at inferior-ess-secondary-prompt))
|
|||
|
(re-search-forward inferior-ess-secondary-prompt (point-at-eol))
|
|||
|
(setq command (concat command "\n"
|
|||
|
(buffer-substring-no-properties (point) (point-at-eol))))
|
|||
|
))
|
|||
|
(forward-line -1)
|
|||
|
(setq ess-temp-point (point)) ;; this is ugly, used by transcript
|
|||
|
command)
|
|||
|
(message "No command at this point")
|
|||
|
""))))
|
|||
|
|
|||
|
(defun inferior-ess-get-old-input ()
|
|||
|
"Return the ESS command surrounding point."
|
|||
|
(if comint-use-prompt-regexp
|
|||
|
(inferior-ess--get-old-input:regexp)
|
|||
|
(inferior-ess--get-old-input:field)))
|
|||
|
|
|||
|
;;;*;;; Hot key commands
|
|||
|
|
|||
|
(defun ess-execute-objects (posn)
|
|||
|
"Send the objects() command to the ESS process.
|
|||
|
By default, gives the objects at position 1.
|
|||
|
A prefix argument toggles the meaning of `ess-execute-in-process-buffer'.
|
|||
|
A prefix argument of 2 or more means get objects for that position.
|
|||
|
A negative prefix argument gets the objects for that position
|
|||
|
and toggles `ess-execute-in-process-buffer' as well."
|
|||
|
(interactive "P")
|
|||
|
(ess-make-buffer-current)
|
|||
|
(let* ((num-arg (if (listp posn)
|
|||
|
(if posn -1 1)
|
|||
|
(prefix-numeric-value posn)))
|
|||
|
(the-posn (if (< num-arg 0) (- num-arg) num-arg))
|
|||
|
(invert (< num-arg 0))
|
|||
|
(the-command (format inferior-ess-objects-command the-posn ".*"))
|
|||
|
(the-message (concat ">>> Position "
|
|||
|
(number-to-string the-posn)
|
|||
|
" ("
|
|||
|
(nth (1- the-posn) (ess-search-list))
|
|||
|
")\n")))
|
|||
|
(ess-execute the-command invert "S objects" the-message)))
|
|||
|
|
|||
|
(defun ess-execute-search (invert)
|
|||
|
"Send the `inferior-ess-search-list-command' command to the `ess-language' process.
|
|||
|
[search(..) in S]"
|
|||
|
(interactive "P")
|
|||
|
(ess-execute inferior-ess-search-list-command invert "S search list"))
|
|||
|
|
|||
|
;; FIXME --- this *only* works in S / S-plus; not in R
|
|||
|
;; ----- ("at least" is not assigned to any key by default)
|
|||
|
(defun ess-execute-attach (dir &optional posn)
|
|||
|
"Attach a directory in the `ess-language' process with the attach() command.
|
|||
|
When used interactively, user is prompted for DIR to attach and
|
|||
|
prefix argument is used for POSN (or 2, if absent.)
|
|||
|
Doesn't work for data frames."
|
|||
|
(interactive "Attach directory: \nP")
|
|||
|
(ess-execute (concat "attach(\""
|
|||
|
(directory-file-name (expand-file-name dir))
|
|||
|
"\""
|
|||
|
(if posn (concat "," (number-to-string
|
|||
|
(prefix-numeric-value posn))))
|
|||
|
")") 'buffer)
|
|||
|
(ess-process-put 'sp-for-help-changed? t))
|
|||
|
|
|||
|
(defun ess-execute-screen-options (&optional invisibly)
|
|||
|
"Cause S to set the \"width\" option to 1 less than the window width.
|
|||
|
Also sets the \"length\" option to 99999. When INVISIBLY is
|
|||
|
non-nil, don't echo to R subprocess.
|
|||
|
|
|||
|
This is a good thing to put in `ess-R-post-run-hook' or
|
|||
|
`ess-S+-post-run-hook'."
|
|||
|
(interactive)
|
|||
|
(if (null ess-execute-screen-options-command)
|
|||
|
(message "Not implemented for '%s'" ess-dialect)
|
|||
|
;; We cannot use (window-width) here because it returns sizes in default
|
|||
|
;; (frame) characters which leads to incorrect sizes with scaled fonts.To
|
|||
|
;; solve this we approximate font width in pixels and use window-pixel-width
|
|||
|
;; to compute the approximate number of characters that fit into line.
|
|||
|
(let* ((wedges (window-inside-pixel-edges))
|
|||
|
(wwidth (- (nth 2 wedges) (nth 0 wedges)))
|
|||
|
(nchars (if (fboundp 'default-font-width)
|
|||
|
(floor (/ wwidth (default-font-width)))
|
|||
|
;; emacs 24
|
|||
|
(if (display-graphic-p)
|
|||
|
(let* ((r (/ (float (frame-char-height)) (frame-char-width)))
|
|||
|
(charh (aref (font-info (face-font 'default)) 3))
|
|||
|
(charw (/ charh r)))
|
|||
|
(- (floor (/ wwidth charw)) 1))
|
|||
|
;; e.g., no X11 as in 'emacs -nw'
|
|||
|
(- (window-width) 2))))
|
|||
|
(command (format ess-execute-screen-options-command nchars)))
|
|||
|
(if invisibly
|
|||
|
(ess-command command)
|
|||
|
(ess-eval-linewise command nil nil nil 'wait-prompt)))))
|
|||
|
|
|||
|
(defun ess-execute (command &optional invert buff message)
|
|||
|
"Send a command to the ESS process.
|
|||
|
A newline is automatically added to COMMAND. Prefix arg (or second arg
|
|||
|
INVERT) means invert the meaning of
|
|||
|
`ess-execute-in-process-buffer'. If INVERT is 'buffer, output is
|
|||
|
forced to go to the process buffer. If the output is going to a
|
|||
|
buffer, name it *BUFF*. This buffer is erased before use. Optional
|
|||
|
fourth arg MESSAGE is text to print at the top of the buffer (defaults
|
|||
|
to the command if BUFF is not given.)"
|
|||
|
(interactive (list
|
|||
|
;; simpler way to set proc name in mb?
|
|||
|
(let ((enable-recursive-minibuffers t)
|
|||
|
(proc-name (progn (ess-force-buffer-current)
|
|||
|
ess-local-process-name)))
|
|||
|
(with-current-buffer (get-buffer " *Minibuf-1*") ;; fixme: hardcoded name
|
|||
|
(setq ess-local-process-name proc-name))
|
|||
|
(read-from-minibuffer "Execute> " nil
|
|||
|
ess-mode-minibuffer-map))
|
|||
|
current-prefix-arg))
|
|||
|
(ess-make-buffer-current)
|
|||
|
(let ((the-command (concat command "\n"))
|
|||
|
(buff-name (concat "*" (or buff "ess-output") "*"))
|
|||
|
(in-pbuff (if invert (or (eq invert 'buffer)
|
|||
|
(not ess-execute-in-process-buffer))
|
|||
|
ess-execute-in-process-buffer)))
|
|||
|
(if in-pbuff
|
|||
|
(ess-eval-linewise the-command)
|
|||
|
(let ((buff (ess-create-temp-buffer buff-name)))
|
|||
|
(ess-command the-command buff);; sleep?
|
|||
|
(with-current-buffer buff
|
|||
|
(goto-char (point-min))
|
|||
|
(if message (insert message)
|
|||
|
(if buff nil
|
|||
|
;; Print the command in the buffer if it has not been
|
|||
|
;; given a special name
|
|||
|
(insert "> " the-command)))
|
|||
|
(setq ess-local-process-name ess-current-process-name))
|
|||
|
(ess-display-temp-buffer buff)))))
|
|||
|
|
|||
|
;;;*;;; Quitting
|
|||
|
|
|||
|
(defun ess-quit ()
|
|||
|
"Issue an exiting command to the inferior process, additionally
|
|||
|
also running \\[ess-cleanup]. For R, runs \\[ess-quit-r], see there."
|
|||
|
(interactive)
|
|||
|
(if (equal ess-dialect "R")
|
|||
|
(ess-quit-r)
|
|||
|
;; else: non-R
|
|||
|
(ess-force-buffer-current "Process to quit: " nil 'no-autostart)
|
|||
|
(ess-make-buffer-current)
|
|||
|
(let ((sprocess (ess-get-process ess-current-process-name)))
|
|||
|
(if (not sprocess) (error "No ESS process running"))
|
|||
|
(when (y-or-n-p (format "Really quit ESS process %s? " sprocess))
|
|||
|
(ess-cleanup)
|
|||
|
(goto-char (marker-position (process-mark sprocess)))
|
|||
|
(insert inferior-ess-exit-command)
|
|||
|
(process-send-string sprocess inferior-ess-exit-command)
|
|||
|
;;SJE - suggest no need to rename buffer upon exit.
|
|||
|
;;(rename-buffer (concat (buffer-name) "-exited") t)
|
|||
|
))))
|
|||
|
|
|||
|
(defun ess-quit-r ()
|
|||
|
"Issue an exiting command to an inferior R process, and optionally clean up.
|
|||
|
This version is for killing *R* processes; it asks the extra question
|
|||
|
regarding whether the workspace image should be saved."
|
|||
|
(ess-force-buffer-current "Process to quit: " nil 'no-autostart)
|
|||
|
(ess-make-buffer-current)
|
|||
|
(let (cmd
|
|||
|
;;Q response
|
|||
|
(sprocess (ess-get-process ess-current-process-name)))
|
|||
|
(if (not sprocess) (error "No ESS process running"))
|
|||
|
;;Q (setq response (completing-read "Save workspace image? "
|
|||
|
;;Q '( ( "yes".1) ("no" . 1) ("cancel" . 1))
|
|||
|
;;Q nil t))
|
|||
|
;;Q (if (string-equal response "")
|
|||
|
;;Q (setq response "default")); which will ask again (in most situations)
|
|||
|
;;Q (unless (string-equal response "cancel")
|
|||
|
(ess-cleanup)
|
|||
|
;;Q (setq cmd (format "q(\"%s\")\n" response))
|
|||
|
(setq cmd "base::q()\n")
|
|||
|
(goto-char (marker-position (process-mark sprocess)))
|
|||
|
(process-send-string sprocess cmd)))
|
|||
|
|
|||
|
(defun ess-abort ()
|
|||
|
"Kill the ESS process, without executing .Last or terminating devices.
|
|||
|
If you want to finish your session, use \\[ess-quit] instead."
|
|||
|
;;; Provided as a safety measure over the default binding of C-c C-z in
|
|||
|
;;; comint-mode-map.
|
|||
|
(interactive)
|
|||
|
(ding)
|
|||
|
(message "WARNING: \\[inferior-ess-exit-command] will not be executed and graphics devices won't finish properly!")
|
|||
|
(sit-for 2)
|
|||
|
(if (y-or-n-p "Still abort? ")
|
|||
|
(comint-quit-subjob)
|
|||
|
(message "Good move.")))
|
|||
|
|
|||
|
(defun ess-cleanup ()
|
|||
|
"Possibly kill or offer to kill, depending on the value of
|
|||
|
`ess-S-quit-kill-buffers-p', all buffers associated with this ESS process.
|
|||
|
Leaves you in the ESS process buffer. It's a good idea to run this
|
|||
|
before you quit. It is run automatically by \\[ess-quit]."
|
|||
|
(interactive)
|
|||
|
(let ((the-procname (or (ess-make-buffer-current) ess-local-process-name)))
|
|||
|
(unless the-procname
|
|||
|
(error "I don't know which ESS process to clean up after!"))
|
|||
|
(when
|
|||
|
(or (eq ess-S-quit-kill-buffers-p t)
|
|||
|
(and
|
|||
|
(eq ess-S-quit-kill-buffers-p 'ask)
|
|||
|
(y-or-n-p
|
|||
|
(format
|
|||
|
"Delete all buffers associated with process %s? " the-procname))))
|
|||
|
(dolist (buf (buffer-list))
|
|||
|
(with-current-buffer buf
|
|||
|
;; Consider buffers for which ess-local-process-name is
|
|||
|
;; the same as the-procname
|
|||
|
(when (and (not (get-buffer-process buf))
|
|||
|
ess-local-process-name
|
|||
|
(equal ess-local-process-name the-procname))
|
|||
|
(kill-buffer buf)))))
|
|||
|
(ess-switch-to-ESS nil)))
|
|||
|
|
|||
|
(defun ess-kill-buffer-function ()
|
|||
|
"Function run just before an ESS process buffer is killed."
|
|||
|
;; This simply deletes the buffers process to avoid an Emacs bug
|
|||
|
;; where the sentinel is run *after* the buffer is deleted
|
|||
|
(let ((proc (get-buffer-process (current-buffer))))
|
|||
|
(if (processp proc) (delete-process proc))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-list-object-completions nil
|
|||
|
"List all possible completions of the object name at point."
|
|||
|
(interactive)
|
|||
|
(ess-complete-object-name))
|
|||
|
|
|||
|
;;;*;;; Support functions
|
|||
|
(defun ess-extract-onames-from-alist (alist posn &optional force)
|
|||
|
"Return the object names in position POSN of ALIST.
|
|||
|
ALIST is an alist like `ess-sl-modtime-alist'. POSN should be in 1 .. (length
|
|||
|
ALIST). If optional third arg FORCE is t, the corresponding element
|
|||
|
of the search list is re-read. Otherwise it is only re-read if it's a
|
|||
|
directory and has been modified since it was last read."
|
|||
|
(let* ((entry (nth (1- posn) alist))
|
|||
|
(dir (car entry))
|
|||
|
(timestamp (car (cdr entry)))
|
|||
|
(new-modtime (and timestamp
|
|||
|
(ess-dir-modtime dir))))
|
|||
|
;; Refresh the object listing if necessary
|
|||
|
(if (or force (not (equal new-modtime timestamp)))
|
|||
|
(setcdr (cdr entry) (ess-object-names dir posn)))
|
|||
|
(cdr (cdr entry))))
|
|||
|
|
|||
|
(defun ess-dir-modtime (dir)
|
|||
|
"Return the last modtime if DIR is a directory, and nil otherwise."
|
|||
|
(and ess-filenames-map
|
|||
|
(file-directory-p dir)
|
|||
|
(nth 5 (file-attributes dir))))
|
|||
|
|
|||
|
(defun ess-object-modtime (object)
|
|||
|
"Return the modtime of the S object OBJECT (a string).
|
|||
|
Searches along the search list for a file named OBJECT and returns its modtime
|
|||
|
Returns nil if that file cannot be found, i.e., for R or any non-S language!"
|
|||
|
(let ((path (ess-search-list))
|
|||
|
result)
|
|||
|
(while (and (not result) path)
|
|||
|
(setq result (file-attributes
|
|||
|
(concat (file-name-as-directory (car path))
|
|||
|
object)))
|
|||
|
(setq path (cdr path)))
|
|||
|
(nth 5 result)))
|
|||
|
|
|||
|
(defun ess-modtime-gt (mod1 mod2)
|
|||
|
"Return t if MOD1 is later than MOD2."
|
|||
|
(and mod1
|
|||
|
(or (> (car mod1) (car mod2))
|
|||
|
(and (= (car mod1) (car mod2))
|
|||
|
(> (car (cdr mod1)) (car (cdr mod2)))))))
|
|||
|
|
|||
|
(defun ess-get-object-list (name &optional exclude-first)
|
|||
|
"Return a list of current S object names associated with process NAME,
|
|||
|
using `ess-object-list' if that is non-nil.
|
|||
|
If exclude-first is non-nil, don't return objects in first positon (.GlobalEnv)."
|
|||
|
(or ess-object-list ;; <<- MM: this is now always(?) nil; we cache the *-modtime-alist
|
|||
|
(with-current-buffer (process-buffer (ess-get-process name))
|
|||
|
(ess-make-buffer-current)
|
|||
|
(ess-write-to-dribble-buffer (format "(get-object-list %s) .." name))
|
|||
|
(if (or (not ess-sl-modtime-alist)
|
|||
|
(ess-process-get 'sp-for-help-changed?))
|
|||
|
(progn (ess-write-to-dribble-buffer "--> (ess-get-modtime-list)\n")
|
|||
|
(ess-get-modtime-list))
|
|||
|
;;else
|
|||
|
(ess-write-to-dribble-buffer " using existing ess-sl-modtime-alist\n"))
|
|||
|
(let* ((alist ess-sl-modtime-alist)
|
|||
|
(i 2)
|
|||
|
(n (length alist))
|
|||
|
result)
|
|||
|
(ess-write-to-dribble-buffer (format " (length alist) : %d\n" n))
|
|||
|
(unless exclude-first
|
|||
|
;; re-read of position 1 :
|
|||
|
(setq result (ess-extract-onames-from-alist alist 1 'force)))
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format " have re-read pos=1: -> length %d\n" (length result)))
|
|||
|
;; Re-read remaining directories if necessary.
|
|||
|
(while (<= i n)
|
|||
|
(setq result
|
|||
|
(append result
|
|||
|
(ess-extract-onames-from-alist alist i)))
|
|||
|
(setq i (1+ i)))
|
|||
|
(setq ess-object-list (ess-uniq-list result))))))
|
|||
|
|
|||
|
(defun ess-get-words-from-vector (command &optional no-prompt-check wait proc)
|
|||
|
"Evaluate the S command COMMAND, which returns a character vector.
|
|||
|
Return the elements of the result of COMMAND as an alist of
|
|||
|
strings. COMMAND should have a terminating newline. WAIT is
|
|||
|
passed to `ess-command'.
|
|||
|
|
|||
|
To avoid truncation of long vectors, wrap your
|
|||
|
command (%s) like this, or a version with explicit options(max.print=1e6):
|
|||
|
|
|||
|
local({ out <- try({%s}); print(out, max=1e6) })\n
|
|||
|
"
|
|||
|
(let ((tbuffer (get-buffer-create
|
|||
|
" *ess-get-words*")); initial space: disable-undo
|
|||
|
words)
|
|||
|
(ess-if-verbose-write (format "ess-get-words*(%s).. " command))
|
|||
|
(ess-command command tbuffer 'sleep no-prompt-check wait proc)
|
|||
|
(ess-if-verbose-write " [ok] ..")
|
|||
|
(with-current-buffer tbuffer
|
|||
|
(goto-char (point-min))
|
|||
|
;; this is bad, only R specific test
|
|||
|
;; (if (not (looking-at "[+ \t>\n]*\\[1\\]"))
|
|||
|
;; (progn (ess-if-verbose-write "not seeing \"[1]\".. ")
|
|||
|
;; (setq words nil)
|
|||
|
;; )
|
|||
|
(while (re-search-forward "\"\\(\\(\\\\\\\"\\|[^\"]\\)*\\)\"\\( \\|$\\)" nil t);match \"
|
|||
|
(setq words (cons (buffer-substring (match-beginning 1)
|
|||
|
(match-end 1)) words))))
|
|||
|
(ess-if-verbose-write
|
|||
|
(if (> (length words) 5)
|
|||
|
(format " |-> (length words)= %d\n" (length words))
|
|||
|
(format " |-> words= '%s'\n" words)))
|
|||
|
(reverse words)))
|
|||
|
|
|||
|
(defun ess-compiled-dir (dir)
|
|||
|
"Return non-nil if DIR is an S object directory with special files.
|
|||
|
I.e. if the filenames in DIR are not representative of the objects in DIR."
|
|||
|
(or (file-exists-p (concat (file-name-as-directory dir) "___nonfile"))
|
|||
|
(file-exists-p (concat (file-name-as-directory dir) "__BIGIN"))
|
|||
|
(file-exists-p (concat (file-name-as-directory dir) "___NONFI"))))
|
|||
|
|
|||
|
(defun ess-object-names (obj &optional pos)
|
|||
|
"Return alist of S object names in directory (or object) OBJ.
|
|||
|
If OBJ is a directory name (begins with `/') returns a listing of that dir.
|
|||
|
This may use the search list position POS if necessary.
|
|||
|
If OBJ is an object name, returns result of the command `inferior-ess-safe-names-command'.
|
|||
|
If POS is supplied return the result of the command in `inferior-ess-objects-command'
|
|||
|
If OBJ is nil or not a directory, POS must be supplied.
|
|||
|
In all cases, the value is an list of object names."
|
|||
|
|
|||
|
(cond ((and (stringp obj)
|
|||
|
(string-match-p "ESSR" obj))
|
|||
|
nil)
|
|||
|
;; FIXME: in both cases below, the same fallback "objects(POS)" is used -- merge!
|
|||
|
((and obj (file-accessible-directory-p obj))
|
|||
|
;; Check the pre-compiled object list in ess-object-name-db first
|
|||
|
|
|||
|
;; FIXME: If used at all, ess-object-name-db should not only
|
|||
|
;; ----- be used in the directory case !!
|
|||
|
(or (cdr-safe (assoc obj ess-object-name-db))
|
|||
|
;; Take a directory listing
|
|||
|
(and ess-filenames-map
|
|||
|
;; first try .Data subdirectory:
|
|||
|
;;FIXME: move ".Data" or ``this function'' to ess-sp6-d.el etc:
|
|||
|
(let ((dir (concat (file-name-as-directory obj) ".Data")))
|
|||
|
(if (not (file-accessible-directory-p dir))
|
|||
|
(setq dir obj))
|
|||
|
(and (not (ess-compiled-dir dir))
|
|||
|
(directory-files dir))))
|
|||
|
;; Get objects(pos) instead
|
|||
|
(and (or (ess-write-to-dribble-buffer
|
|||
|
(format "(ess-object-names ..): directory %s not used\n" obj))
|
|||
|
t)
|
|||
|
pos
|
|||
|
(ess-get-words-from-vector
|
|||
|
(format inferior-ess-objects-command pos)))))
|
|||
|
((and obj ;; want names(obj)
|
|||
|
(ess-get-words-from-vector
|
|||
|
(format inferior-ess-safe-names-command obj))))
|
|||
|
(pos
|
|||
|
(ess-get-words-from-vector
|
|||
|
(format inferior-ess-objects-command pos)))))
|
|||
|
|
|||
|
(defun ess-slot-names (obj)
|
|||
|
"Return alist of S4 slot names of S4 object OBJ."
|
|||
|
(ess-get-words-from-vector (format "slotNames(%s)\n" obj)))
|
|||
|
|
|||
|
|
|||
|
;;; SJE: Wed 29 Dec 2004 --- remove this function.
|
|||
|
;;; rmh: Wed 5 Jan 2005 --- bring it back for use on Windows
|
|||
|
(defun ess-create-object-name-db ()
|
|||
|
"Create a database of object names in standard S directories. This
|
|||
|
database is saved in the file specified by `ess-object-name-db-file',
|
|||
|
and is loaded when `ess-mode' is loaded. It defines the variable
|
|||
|
`ess-object-name-db', which is used for completions.
|
|||
|
|
|||
|
Before you call this function, modify the S search list so that it contains
|
|||
|
all the non-changing (i.e. system) S directories. All positions of the search
|
|||
|
list except for position 1 are searched and stored in the database.
|
|||
|
|
|||
|
After running this command, you should move ess-namedb.el to a directory in
|
|||
|
the `load-path'."
|
|||
|
(interactive)
|
|||
|
(setq ess-object-name-db nil)
|
|||
|
(let ((search-list (cdr (ess-search-list)))
|
|||
|
(pos 2)
|
|||
|
name
|
|||
|
(buffer (get-buffer-create " *ess-db*"))
|
|||
|
(temp-object-name-db nil)
|
|||
|
(temp-object-name-db-file ess-object-name-db-file))
|
|||
|
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(object db): search-list=%s \n " search-list))
|
|||
|
(while search-list
|
|||
|
(message "Searching %s" (car search-list))
|
|||
|
(setq temp-object-name-db (cons (cons (car search-list)
|
|||
|
(ess-object-names nil pos))
|
|||
|
temp-object-name-db))
|
|||
|
(setq search-list (cdr search-list))
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(object db): temp-obj-name-db=%s \n pos=%s"
|
|||
|
temp-object-name-db pos))
|
|||
|
(setq pos (1+ pos)))
|
|||
|
|
|||
|
(with-current-buffer buffer
|
|||
|
(erase-buffer)
|
|||
|
(insert "(setq ess-object-name-db '")
|
|||
|
(prin1 temp-object-name-db (current-buffer))
|
|||
|
(insert ")\n")
|
|||
|
(setq name (expand-file-name ess-object-name-db-file))
|
|||
|
(write-region (point-min) (point-max) name)
|
|||
|
(message "Wrote %s" name))
|
|||
|
(kill-buffer buffer)
|
|||
|
(setq ess-object-name-db temp-object-name-db)))
|
|||
|
|
|||
|
(defun ess-resynch nil
|
|||
|
"Reread all directories/objects in variable `ess-search-list' to
|
|||
|
form completions."
|
|||
|
(interactive)
|
|||
|
|
|||
|
(if (ess-make-buffer-current) nil
|
|||
|
(error "Not an ESS process buffer"))
|
|||
|
(setq ess-sl-modtime-alist nil)
|
|||
|
(setq ess-object-list nil)
|
|||
|
(setq ess-object-name-db nil) ; perhaps it would be better to reload?
|
|||
|
(ess-process-put 'sp-for-help-changed? t)
|
|||
|
(ess-get-modtime-list))
|
|||
|
|
|||
|
(defun ess-filename-completion ()
|
|||
|
;; > emacs 24
|
|||
|
"Return completion only within string or comment."
|
|||
|
(save-restriction ;; explicitely handle inferior-ess
|
|||
|
(ignore-errors
|
|||
|
(when (and (eq major-mode 'inferior-ess-mode)
|
|||
|
(> (point) (process-mark (get-buffer-process (current-buffer)))))
|
|||
|
(narrow-to-region (process-mark (get-buffer-process (current-buffer)))
|
|||
|
(point-max))))
|
|||
|
(when (ess-inside-string-or-comment-p (point))
|
|||
|
(append (comint-filename-completion) '(:exclusive no)))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-complete-filename ()
|
|||
|
"Do file completion only within strings."
|
|||
|
(save-restriction ;; explicitely handle inferior-ess
|
|||
|
(ignore-errors
|
|||
|
(when (and (eq major-mode 'inferior-ess-mode)
|
|||
|
(> (point) (process-mark (get-buffer-process (current-buffer)))))
|
|||
|
(narrow-to-region (process-mark (get-buffer-process (current-buffer)))
|
|||
|
(point-max))))
|
|||
|
(when (or (ess-inside-string-or-comment-p (point))) ;; usable within ess-mode as well
|
|||
|
(comint-dynamic-complete-filename))))
|
|||
|
|
|||
|
(defun ess-after-pathname-p nil
|
|||
|
;; Heuristic: after partial pathname if it looks like we're in a
|
|||
|
;; string, and that string looks like a pathname. Not the best for
|
|||
|
;; use with unix() (or it's alias, !). Oh well.
|
|||
|
(save-excursion
|
|||
|
(save-match-data
|
|||
|
(let ((opoint (point)))
|
|||
|
(and (re-search-backward "\\(\"\\|'\\)[~/#$.a-zA-Z0-9][^ \t\n\"']*"
|
|||
|
nil t)
|
|||
|
(eq opoint (match-end 0)))))))
|
|||
|
|
|||
|
;;*;; Functions handling the search list
|
|||
|
|
|||
|
(defun ess-search-list (&optional force-update)
|
|||
|
"Return the current search list as a list of strings.
|
|||
|
Elements which are apparently directories are expanded to full dirnames.
|
|||
|
Don't try to use cache if FORCE-UPDATE is non-nil.
|
|||
|
|
|||
|
Is *NOT* used by \\[ess-execute-search],
|
|||
|
but by \\[ess-resynch], \\[ess-get-object-list], \\[ess-get-modtime-list],
|
|||
|
\\[ess-execute-objects], \\[ess-object-modtime], \\[ess-create-object-name-db],
|
|||
|
and (indirectly) by \\[ess-get-help-files-list]."
|
|||
|
(with-current-buffer
|
|||
|
(ess-get-process-buffer ess-current-process-name);to get *its* local vars
|
|||
|
(let ((result nil)
|
|||
|
(slist (ess-process-get 'search-list))
|
|||
|
(tramp-mode nil)) ;; hack for bogus file-directory-p below
|
|||
|
(if (and slist
|
|||
|
(not force-update)
|
|||
|
(not (ess-process-get 'sp-for-help-changed?)))
|
|||
|
slist
|
|||
|
;; else, re-compute:
|
|||
|
(ess-write-to-dribble-buffer " (ess-search-list ... ) ")
|
|||
|
(let ((tbuffer (get-buffer-create " *search-list*"))
|
|||
|
(homedir ess-directory)
|
|||
|
(my-search-cmd inferior-ess-search-list-command); from ess-buffer
|
|||
|
elt)
|
|||
|
(ess-command my-search-cmd tbuffer 0.05); <- sleep for dde only; does (erase-buffer)
|
|||
|
(with-current-buffer tbuffer
|
|||
|
;; guaranteed by the initial space in its name: (buffer-disable-undo)
|
|||
|
(goto-char (point-min))
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "after '%s', point-max=%d\n" my-search-cmd (point-max)))
|
|||
|
(while (re-search-forward "\"\\([^\"]*\\)\"" nil t)
|
|||
|
(setq elt (buffer-substring (match-beginning 1) (match-end 1)))
|
|||
|
;;Dbg: (ess-write-to-dribble-buffer (format " .. elt= %s \t" elt))
|
|||
|
(if (and (string-match "^[^/]" elt)
|
|||
|
(file-directory-p (concat ess-directory elt)))
|
|||
|
(progn
|
|||
|
;;Dbg: (ess-write-to-dribble-buffer "*IS* directory\n")
|
|||
|
(setq elt (concat homedir elt)))
|
|||
|
;;else
|
|||
|
;;dbg
|
|||
|
;;- (ess-write-to-dribble-buffer "not dir.\n")
|
|||
|
)
|
|||
|
(setq result (append result (list elt))))
|
|||
|
(kill-buffer tbuffer)))
|
|||
|
result))))
|
|||
|
|
|||
|
;;; ess-sl-modtime-alist is a list with elements as follows:
|
|||
|
;;; * key (directory or object name)
|
|||
|
;;; * modtime (list of 2 integers)
|
|||
|
;;; * name, name ... (accessible objects in search list posn labeled by key)
|
|||
|
;;; It is a buffer-local variable (belonging to e.g. *R*, *S+6*, .. etc)
|
|||
|
;;; and has the same number of elements and is in the same order as the
|
|||
|
;;; S search list
|
|||
|
|
|||
|
(defun ess-get-modtime-list (&optional cache-var-name exclude-first)
|
|||
|
"Record directories in the search list, and the objects in those directories.
|
|||
|
The result is stored in CACHE-VAR-NAME. If nil, CACHE-VAR-NAME
|
|||
|
defaultst to `ess-sl-modtime-alist'. If EXCLUDE-FIRST is non-nil
|
|||
|
don't recompile first object in the search list."
|
|||
|
;; Operation applies to process of current buffer
|
|||
|
(let* ((searchlist (if exclude-first
|
|||
|
(cdr (ess-search-list))
|
|||
|
(ess-search-list)))
|
|||
|
(index (if exclude-first 2 1))
|
|||
|
(cache-name (or cache-var-name 'ess-sl-modtime-alist))
|
|||
|
pack newalist)
|
|||
|
(while searchlist
|
|||
|
(setq pack (car searchlist))
|
|||
|
(setq newalist
|
|||
|
(append
|
|||
|
newalist
|
|||
|
(list (or (assoc pack (symbol-value cache-name))
|
|||
|
(append
|
|||
|
(list pack (ess-dir-modtime pack))
|
|||
|
(prog2
|
|||
|
(message "Forming completions for %s..." pack)
|
|||
|
(ess-object-names pack index)
|
|||
|
(message "Forming completions for %s...done" pack)))))))
|
|||
|
(setq index (1+ index))
|
|||
|
(setq searchlist (cdr searchlist)))
|
|||
|
;;DBG:
|
|||
|
(ess-write-to-dribble-buffer
|
|||
|
(format "(%s): created new alist of length %d\n"
|
|||
|
cache-var-name (length newalist)))
|
|||
|
(set cache-name newalist)))
|
|||
|
|
|||
|
|
|||
|
(defun ess-search-path-tracker (str)
|
|||
|
"Check if input STR changed the search path.
|
|||
|
This function monitors user input to the inferior ESS process so
|
|||
|
that Emacs can keep the process variable 'search-list' up to
|
|||
|
date. `ess-completing-read' in \\[ess-read-object-name] uses this
|
|||
|
list indirectly when it prompts for help or for an object to
|
|||
|
dump.
|
|||
|
|
|||
|
From ESS 12.09 this is not necessary anymore, as the search path
|
|||
|
is checked on idle time. It is kept for robustness and backward
|
|||
|
compatibility only."
|
|||
|
(when ess-change-sp-regexp
|
|||
|
(if (string-match ess-change-sp-regexp str)
|
|||
|
(ess-process-put 'sp-for-help-changed? t))))
|
|||
|
|
|||
|
; Miscellaneous routines
|
|||
|
|
|||
|
;;;*;;; Routines for reading object names
|
|||
|
(defun ess-read-object-name (p-string)
|
|||
|
"Read an S object name from the minibuffer with completion, and return it.
|
|||
|
P-STRING is the prompt string."
|
|||
|
(let* ((default (ess-read-object-name-dump))
|
|||
|
(object-list (ess-get-object-list ess-local-process-name))
|
|||
|
(spec (ess-completing-read p-string object-list nil nil nil nil default)))
|
|||
|
(list (cond
|
|||
|
((string= spec "") default)
|
|||
|
(t spec)))))
|
|||
|
|
|||
|
(defun ess-read-object-name-default ()
|
|||
|
"Return the object name at point, or nil if none."
|
|||
|
(condition-case ()
|
|||
|
(save-excursion
|
|||
|
;; The following line circumvents an 18.57 bug in following-char
|
|||
|
(if (eobp) (backward-char 1)) ; Hopefully buffer is not empty!
|
|||
|
;; Get onto a symbol
|
|||
|
(catch 'nosym ; bail out if there's no symbol at all before point
|
|||
|
(while (/= (char-syntax (following-char)) ?w)
|
|||
|
(if (bobp) (throw 'nosym nil) (backward-char 1)))
|
|||
|
(let*
|
|||
|
((end (progn (forward-sexp 1) (point)))
|
|||
|
(beg (progn (backward-sexp 1) (point))))
|
|||
|
(buffer-substring-no-properties beg end))))
|
|||
|
(error nil)))
|
|||
|
|
|||
|
(defun ess-read-object-name-dump ()
|
|||
|
"Return the object name at point, or \"Temporary\" if none."
|
|||
|
(condition-case ()
|
|||
|
(save-excursion
|
|||
|
;; The following line circumvents an 18.57 bug in following-char
|
|||
|
(if (eobp) (backward-char 1)) ; Hopefully buffer is not empty!
|
|||
|
;; Get onto a symbol
|
|||
|
(catch 'nosym ; bail out if there's no symbol at all before point
|
|||
|
(while (/= (char-syntax (following-char)) ?w)
|
|||
|
(if (bobp) (throw 'nosym nil) (backward-char 1)))
|
|||
|
(let*
|
|||
|
((end (progn (forward-sexp 1) (point)))
|
|||
|
(beg (progn (backward-sexp 1) (point)))
|
|||
|
(object-name (buffer-substring beg end)))
|
|||
|
(or object-name "Temporary"))))
|
|||
|
(error nil)))
|
|||
|
|
|||
|
;;;; start of ess-smart-operators
|
|||
|
;;;; inspired by slime repl shortcuts
|
|||
|
|
|||
|
(defvar ess--handy-history nil)
|
|||
|
|
|||
|
(defun ess-handy-commands ()
|
|||
|
"Request and execute a command from `ess-handy-commands' list."
|
|||
|
(interactive)
|
|||
|
(let* ((commands (or ess--local-handy-commands
|
|||
|
ess-handy-commands))
|
|||
|
(hist (and (assoc (car ess--handy-history)
|
|||
|
commands)
|
|||
|
(car ess--handy-history))))
|
|||
|
(call-interactively
|
|||
|
(cdr (assoc (ess-completing-read "Execute"
|
|||
|
(sort (mapcar 'car commands)
|
|||
|
'string-lessp) nil t nil
|
|||
|
'ess--handy-history hist)
|
|||
|
commands)))))
|
|||
|
|
|||
|
(defun ess-smart-comma ()
|
|||
|
"If comma is invoked at the process marker of an ESS inferior
|
|||
|
buffer, request and execute a command from `ess-handy-commands'
|
|||
|
list."
|
|||
|
(interactive)
|
|||
|
(let ((proc (get-buffer-process (current-buffer))))
|
|||
|
(if (and proc
|
|||
|
(eq (point) (marker-position (process-mark proc))))
|
|||
|
(ess-handy-commands)
|
|||
|
(if ess-smart-operators
|
|||
|
(progn
|
|||
|
(delete-horizontal-space)
|
|||
|
(insert ", ")
|
|||
|
(unless (eq major-mode 'inferior-ess-mode)
|
|||
|
(indent-according-to-mode)))
|
|||
|
(insert ",")))))
|
|||
|
|
|||
|
; directories
|
|||
|
(defun ess-set-working-directory (path &optional no-error)
|
|||
|
"Set the current working directory to PATH for both ESS
|
|||
|
subprocess and Emacs buffer `default-directory'."
|
|||
|
(interactive "DChange working directory to: ")
|
|||
|
(if ess-setwd-command
|
|||
|
(let* ((remote (file-remote-p path))
|
|||
|
(path (if remote
|
|||
|
(tramp-sh-handle-expand-file-name path)
|
|||
|
path))
|
|||
|
(lpath (if remote
|
|||
|
(with-parsed-tramp-file-name path v v-localname)
|
|||
|
path)))
|
|||
|
(ess-eval-linewise (format ess-setwd-command lpath))
|
|||
|
;; use file-name-as-directory to ensure it has trailing /
|
|||
|
(setq default-directory (file-name-as-directory path)))
|
|||
|
(unless no-error
|
|||
|
(error "Not implemented for dialect %s" ess-dialect))))
|
|||
|
|
|||
|
(defalias 'ess-change-directory 'ess-set-working-directory)
|
|||
|
|
|||
|
(defun ess-get-working-directory (&optional no-error)
|
|||
|
"Retrive the current working directory from the current ess process."
|
|||
|
(if ess-getwd-command
|
|||
|
(car (ess-get-words-from-vector ess-getwd-command))
|
|||
|
(unless no-error
|
|||
|
(error "Not implemented for dialect %s" ess-dialect))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-synchronize-dirs ()
|
|||
|
"Set Emacs' current directory to be the same as the subprocess directory.
|
|||
|
Used in `ess-idle-timer-functions'."
|
|||
|
(when (and ess-can-eval-in-background
|
|||
|
ess-getwd-command)
|
|||
|
(ess-when-new-input last-sync-dirs
|
|||
|
(ess-if-verbose-write "\n(ess-synchronize-dirs)\n")
|
|||
|
(setq default-directory
|
|||
|
(car (ess-get-words-from-vector ess-getwd-command)))
|
|||
|
default-directory)))
|
|||
|
|
|||
|
(defun ess-dirs ()
|
|||
|
"Set Emacs' current directory to be the same as the *R* process."
|
|||
|
;; Note: This function is not necessary anymore. The Emacs
|
|||
|
;; default-directory and subprocess working directory are
|
|||
|
;; synchronized automatically.
|
|||
|
(interactive)
|
|||
|
(let ((dir (car (ess-get-words-from-vector "getwd()\n"))))
|
|||
|
(message "(ESS / default) directory: %s" dir)
|
|||
|
(setq default-directory (file-name-as-directory dir))))
|
|||
|
|
|||
|
;; (make-obsolete 'ess-dirs 'ess-synchronize-dirs "ESS 12.09")
|
|||
|
|
|||
|
;; search path
|
|||
|
(defun ess--mark-search-list-as-changed ()
|
|||
|
"Internal. Marks all the search-list related variables as
|
|||
|
changed."
|
|||
|
;; other guys might track their own
|
|||
|
(ess-process-put 'sp-for-help-changed? t)
|
|||
|
(ess-process-put 'sp-for-ac-changed? t))
|
|||
|
|
|||
|
(defun ess-cache-search-list ()
|
|||
|
"Used in `ess-idle-timer-functions', to set
|
|||
|
search path related variables."
|
|||
|
(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))
|
|||
|
(old-path (process-get *proc* 'search-list)))
|
|||
|
(when (not (equal path old-path))
|
|||
|
(process-put *proc* 'search-list path)
|
|||
|
(ess--mark-search-list-as-changed)
|
|||
|
path)))))
|
|||
|
|
|||
|
|
|||
|
;;*;; Temporary buffer handling
|
|||
|
|
|||
|
;; (defun ess-create-temp-buffer (name)
|
|||
|
;; "Create an empty buffer called NAME, but doesn't display it."
|
|||
|
;; (let ((buff (get-buffer-create name)))
|
|||
|
;; (save-excursion
|
|||
|
;; (set-buffer buff)
|
|||
|
;; (erase-buffer))
|
|||
|
;; buff))
|
|||
|
|
|||
|
|
|||
|
;; Ed Kademan's version:
|
|||
|
;; From: Ed Kademan <kademan@phz.com>
|
|||
|
;; Subject: Re: ess-mode 5.1.16; search list
|
|||
|
;; To: rossini@biostat.washington.edu (A.J. Rossini)
|
|||
|
;; Cc: Martin Maechler <maechler@stat.math.ethz.ch>, ess-bugs@stat.math.ethz.ch
|
|||
|
;; Date: 26 Jul 2000 16:12:12 -0400
|
|||
|
|
|||
|
;; Dear Tony Rossini,
|
|||
|
|
|||
|
;; I was having trouble looking at the search list under ess. When I
|
|||
|
;; started up multiple inferior processes---each for a different
|
|||
|
;; dialect---ess-mode would issue the wrong variant of the "search"
|
|||
|
;; command when I typed C-c C-s. In case it is useful let me tell you
|
|||
|
;; what I did to get it to work for me.
|
|||
|
|
|||
|
;; I added the component:
|
|||
|
;; (inferior-ess-search-list-command . "search()\n")
|
|||
|
;; to S+3-customize-alist and R-customize-alist, and then I redefined the
|
|||
|
;; ess-create-temp-buffer function as follows:
|
|||
|
(defun ess-create-temp-buffer (name)
|
|||
|
"Create an empty buffer called NAME."
|
|||
|
(let ((buff (get-buffer-create name))
|
|||
|
(elca (eval ess-local-customize-alist)))
|
|||
|
(with-current-buffer buff
|
|||
|
(erase-buffer)
|
|||
|
(ess-setq-vars-local elca buff))
|
|||
|
buff))
|
|||
|
;;These two steps seem to insure that the temporary buffer in which the
|
|||
|
;;search results appear has the correct version of the local variables.
|
|||
|
;;I am not that well acquainted with the ess code and don't know whether
|
|||
|
;;this is a good fundamental way of fixing the problem, or even whether
|
|||
|
;;or not this breaks some other feature of ess-mode that I never use.
|
|||
|
;;Thanks for listening.
|
|||
|
;;Ed K.
|
|||
|
;;--
|
|||
|
;;Ed Kademan 508.651.3700
|
|||
|
;;PHZ Capital Partners 508.653.1745 (fax)
|
|||
|
;;321 Commonwealth Road <kademan@phz.com>
|
|||
|
;;Wayland, MA 01778
|
|||
|
|
|||
|
|
|||
|
|
|||
|
(defun ess-display-temp-buffer (buff)
|
|||
|
"Display the buffer BUFF using `temp-buffer-show-function' and respecting
|
|||
|
`ess-display-buffer-reuse-frames'."
|
|||
|
(let ((display-buffer-reuse-frames ess-display-buffer-reuse-frames))
|
|||
|
(funcall (or temp-buffer-show-function 'display-buffer) buff)))
|
|||
|
|
|||
|
;;*;; Error messages
|
|||
|
|
|||
|
(defun ess-error (msg)
|
|||
|
"Something bad has happened.
|
|||
|
Display the S buffer, and cause an error displaying MSG."
|
|||
|
(display-buffer (process-buffer (ess-get-process ess-current-process-name)))
|
|||
|
(error msg))
|
|||
|
|
|||
|
; Provide package
|
|||
|
|
|||
|
(provide 'ess-inf)
|
|||
|
; Local variables section
|
|||
|
|
|||
|
;;; This file is automatically placed in Outline minor mode.
|
|||
|
;;; The file is structured as follows:
|
|||
|
;;; Chapters: ^L ;
|
|||
|
;;; Sections: ;;*;;
|
|||
|
;;; Subsections: ;;;*;;;
|
|||
|
;;; Components: defuns, defvars, defconsts
|
|||
|
;;; Random code beginning with a ;;;;* comment
|
|||
|
|
|||
|
;;; Local variables:
|
|||
|
;;; mode: emacs-lisp
|
|||
|
;;; outline-minor-mode: nil
|
|||
|
;;; mode: outline-minor
|
|||
|
;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
|
|||
|
;;; End:
|
|||
|
|
|||
|
;;; ess-inf.el ends here
|