unix-conf/.emacs.d/elpa/ess-20160208.453/lisp/ess-developer.el

473 lines
20 KiB
EmacsLisp
Raw Normal View History

2016-02-18 13:53:30 +00:00
;;; ess-developer.el --- Developer mode for R.
;; Copyright (C) 2011-2015 V. Spinu, A.J. Rossini, Richard M. Heiberger, Martin
;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
;; Author: Vitalie Spinu
;; Created: 12-11-2011
;; Maintainer: ESS-core <ESS-core@r-project.org>
;; Keywords: languages, tools
;; 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:
;; see apropriate documentation section of ESS user manual
;;; Code:
;; (require 'ess-site) ;; need to assigne the keys in the map
(defgroup ess-developer nil
"ESS: developer."
:group 'ess
:prefix "ess-developer-")
(defface ess-developer-indicator-face
'((((class grayscale)) (:background "DimGray"))
(((class color) (background light))
(:foreground "red4" :bold t ))
(((class color) (background dark))
(:foreground "deep sky blue" :bold t )))
"Face to highlight mode line process name when developer mode is on."
:group 'ess-developer)
(defcustom ess-developer-packages nil
"List of names of R packages you currently develop.
Set this variable to the list of packages you commonly develop or
use `ess-developer-add-package' to modify interactively this
list."
:group 'ess-developer
:type 'list)
(defcustom ess-developer-load-package-command "library(devtools)\nload_all('%s')\n"
"Command issued by `ess-developer-load-package'.
%s is subsituted with the user supplied directory."
:group 'ess-developer
:type 'string)
(defvar ess-developer-root-file "DESCRIPTION"
"If this file is present in the directory, it is considered a
project root.")
;; (defcustom ess-developer-force-attach nil
;; "If non-nill all the packages listed in `ess-developer-packages' should be attached
;; when ess-developer mode is turned on."
;; :group 'ess-developer
;; :type 'boolean)
(defcustom ess-developer-enter-hook nil
"Normal hook run on entering `ess-developer' mode."
:group 'ess-developer
:type 'hook)
(defcustom ess-developer-exit-hook nil
"Normal hook run on exiting `ess-developer' mode."
:group 'ess-developer
:type 'hook)
(defcustom ess-developer-activate-in-package t
"If non-nil, `ess-developer' is automatically turned on within R packages.
The activation is triggered only for packages currently listed in
`ess-developer-packages'."
:group 'ess-developer
:type 'boolean)
(defcustom ess-developer-load-on-add-commands '(("library" . "library(%n)")
("load_all" . "library(devtools)\nload_all('%d')"))
"Alist of available load commands what are proposed for loading
on `ess-developer-add-package'.
%n is replaced with package name,
%d is replaced with package directory.
See also `ess-developer-load-package' for related functionality."
:group 'ess-developer
:type 'alist)
(defvar ess-developer--load-hist nil)
(defun ess-developer-add-package (&optional attached-only)
"Add a package to `ess-developer-packages' list.
With prefix argument only choose from among attached packages."
(interactive "P")
(ess-force-buffer-current)
(let* ((packs (ess-get-words-from-vector
(format "print(unique(c(.packages(), %s)), max=1e6)\n"
(if attached-only "NULL" ".packages(TRUE)"))))
(cur-pack (ess-developer--get-package-name))
(sel (ess-completing-read "Add package" packs nil nil nil nil
(unless (member cur-pack ess-developer-packages)
cur-pack)))
(check-attached (format ".ess_package_attached('%s')\n" sel)))
(unless (ess-boolean-command check-attached)
(let* ((fn (if (> (length ess-developer-load-on-add-commands) 1)
(ess-completing-read "Package not loaded. Use"
(mapcar 'car ess-developer-load-on-add-commands) nil t
nil 'ess-developer--load-hist
(car ess-developer--load-hist))
(caar ess-developer-load-on-add-commands)))
(cmd (cdr (assoc fn ess-developer-load-on-add-commands))))
(setq cmd (replace-regexp-in-string "%n" sel cmd))
(when (string-match-p "%d" cmd)
(let ((dir (read-directory-name
"Package: " (ess-developer--get-package-path sel) nil t nil)))
(setq cmd (replace-regexp-in-string "%d" dir cmd))))
(ess-eval-linewise (concat cmd "\n")))
(ess-wait-for-process)
(when (not (ess-boolean-command check-attached))
(error "Package '%s' could not be added" sel)))
(setq ess-developer-packages
(ess-uniq-list (append ess-developer-packages (list sel))))
;; turn developer in all files from selected package
(ess-developer-activate-in-package sel 'all)
(message "You are developing: %s" ess-developer-packages)))
(defun ess-developer-remove-package ()
"Remove packages from `ess-developer-packages' list; defaults to *ALL*."
(interactive)
(unless ess-developer-packages
(error "Nothing to remove, 'ess-developer-packages' is empty"))
(let ((sel (ess-completing-read "Remove package(s)"
(append ess-developer-packages (list "*ALL*"))
nil t nil nil "*ALL*")))
(if (equal "*ALL*" sel)
(progn
(setq ess-developer-packages nil)
(ess-developer-deactivate-in-package nil 'all)
(message "Removed *ALL* packages from the `ess-developer-packages' list."))
(setq ess-developer-packages (delete sel ess-developer-packages))
(ess-developer-deactivate-in-package sel 'all)
(message "Removed package '%s' from the `ess-developer-packages' list"
(propertize sel 'face 'font-lock-function-name-face)))))
(defun ess-developer-send-region-fallback (proc beg end visibly &optional message tracebug func)
(if tracebug
(ess-tracebug-send-region proc beg end visibly message t)
(ess-send-region proc beg end visibly message)))
(defun ess-developer-source-current-file (&optional filename)
"Ask for namespace to source the current file into.
If *current* is selected just invoke source('file_name'),
otherwise call devSource."
(interactive)
(ess-force-buffer-current "R process to use: ")
(unless ess-developer
(error "Ess-developer mode is not active"))
(if (not (or filename
buffer-file-name))
(error "Buffer '%s' doesn't visit a file" (buffer-name (current-buffer)))
(let* ((filename (or filename buffer-file-name))
(file (file-name-nondirectory filename))
(all-packs (append ess-developer-packages (list "*current*" )))
(default (car (member (car ess-developer--hist) all-packs)))
(env (ess-completing-read (format "devSource '%s' into" file)
all-packs nil t nil 'ess-developer--hist default))
(comm (if (equal env "*current*")
(format "source(file=\"%s\", local=F)\n cat(\"Sourced file '%s' into\", capture.output(environment()), '\n')" filename file)
(format ".essDev_source(source='%s',package='%s')" filename env))))
(when (buffer-modified-p) (save-buffer))
(message "devSourcing '%s' ..." file)
(ess-developer--command comm 'ess-developer--propertize-output))))
(defun ess-developer--exists-in-ns (var ns)
;; If namespace does not exist, the R code below throw an error. But that's equivalent to FALSE.
(let ((cmd "as.character(exists('%s', envir=asNamespace('%s'), mode='function', inherits=FALSE))\n"))
(ess-boolean-command
(format cmd var ns))))
(defun ess-developer-send-function (proc beg end name &optional visibly message tracebug)
(save-excursion
(if (null ess-developer-packages)
(error "`ess-developer-packages' is empty (add packages with C-c C-t C-a).")
(if (null name)
(error "Oops, could not find function name (probably a regexp bug)")
(let ((nms (ess-get-words-from-vector "loadedNamespaces()\n"))
(dev-packs ess-developer-packages)
(default-ns (ess-developer--get-package-name))
assigned-p ns)
(if (string-match-p ess-set-function-start (concat name "("))
;; if setMethod, setClass etc, do send region
(ess-developer-send-region proc beg end visibly message tracebug)
(when tracebug (ess-tracebug-set-last-input proc))
(if (member default-ns dev-packs)
(ess-developer-devSource beg end default-ns message)
;; iterate over all developed packages and check if functions
;; exists in that namespace
(while (and (setq ns (pop dev-packs))
(not assigned-p))
(when (and (member ns nms)
(ess-developer--exists-in-ns name ns))
(ess-developer-devSource beg end ns message)
(setq assigned-p t)))
;; last resort - assign in current env
(unless assigned-p
(ess-developer-send-region-fallback proc beg end visibly message tracebug)))))))))
(defvar ess-developer--hist nil)
(defun ess-developer-send-region (proc beg end &optional visibly message tracebug)
"Ask for for the package and devSource region into it."
(let* ((all-packs (append ess-developer-packages (list "*current*" )))
(default (car (member (car ess-developer--hist) all-packs)))
(package
(ess-completing-read "devEval into" all-packs
nil t nil 'ess-developer--hist default)))
(message (if message (format "dev%s ..." message)))
(if (equal package "*current*")
(ess-developer-send-region-fallback proc beg end visibly message tracebug)
;; else, (ignore VISIBLY here)
(ess-developer-devSource beg end package message))))
(defun ess-developer-devSource (beg end package &optional message)
(let* ((ess-eval-command
(format ".essDev.eval(\"%s\", package=\"%s\", file=\"%s\")" "%s" package "%f"))
(ess-eval-visibly-command ess-eval-command)
(ess-eval-visibly-noecho-command ess-eval-command))
(if message (message message))
(ess-developer--command (ess--make-source-refd-command beg end)
'ess-developer--propertize-output)))
(defun ess-developer--command (comm &optional propertize-func)
"Evaluate the command and popup a message with the output if succed.
On error insert the error at the end of the inferior-ess buffer.
PROPERTIZE-FUNC is a function called with the output buffer being
current. usually used to manipulate the output, for example to
propertize output text.
"
(setq comm (format "eval({cat(\"\\n\")\n%s\ncat(\"!@OK@!\")})\n" comm))
(let ((buff (get-buffer-create " *ess-command-output*"))
out)
(ess-command comm buff nil nil 0.1)
(with-current-buffer buff
(goto-char (point-min))
(delete-region (point) (min (point-max) ;; delete + + +
(1+ (point-at-eol))))
(goto-char (point-max))
(if (re-search-backward "!@OK@!" nil t)
(progn
(when (fboundp propertize-func)
(save-excursion (funcall propertize-func)))
(message "%s" (buffer-substring (point-min) (max (point-min)
(1- (point))))))
(message "%s" (buffer-substring-no-properties (point-min) (point-max)))))))
(defun ess-developer--propertize-output ()
(goto-char (point-min))
(while (re-search-forward "\\(FUN\\|CLS\\|METH\\)\\[" nil t)
(put-text-property (match-beginning 1) (match-end 1)
'face 'font-lock-function-name-face))
(goto-char (point-min))
(while (re-search-forward "\\([^ \t]+\\):" nil t)
(put-text-property (match-beginning 1) (match-end 1)
'face 'font-lock-keyword-face)))
(defvar ess-developer--pack-name nil)
(make-variable-buffer-local 'ess-developer--pack-name)
(defun ess-developer--get-package-path (&optional pack-name)
"Get the root of R package that contains current directory.
Root is determined by locating `ess-developer-root-file'.
If PACK-NAME is given, iterate over default-directories of all
open R files till package with name pack-name is found. If not
found, return nil."
(if pack-name
(let ((bl (buffer-list))
path bf)
(while (and (setq bf (pop bl))
(not path))
(when (buffer-local-value 'ess-dialect bf)
(with-current-buffer bf
(setq path (ess-developer--get-package-path))
(unless (equal pack-name (ess-developer--get-package-name))
(setq path nil)))))
path)
(let ((path (directory-file-name default-directory)))
(when (string= "R" (file-name-nondirectory path))
(setq path (file-name-directory path))
(when (file-exists-p (expand-file-name ess-developer-root-file path))
path)))
;; This following version is incredibly slow on remotes:
;; (let ((path default-directory)
;; opath package)
;; (while (and path
;; (not package)
;; (not (equal path opath)))
;; (if (file-exists-p (expand-file-name ess-developer-root-file path))
;; (setq package path)
;; (setq opath path
;; path (file-name-directory (directory-file-name path)))))
;; package)
))
(defun ess-developer--get-package-name (&optional path force)
"Find package name in path. Parses DESCRIPTION file in PATH (R
specific so far). PATH defaults to the value returned
by (ess-developer--get-package-path).
If FORCE is non-nil, don't check for buffer local cached value of
the package name."
(or (and (not force)
ess-developer--pack-name)
(when (setq path (or path (ess-developer--get-package-path)))
(let ((file (expand-file-name ess-developer-root-file path))
(case-fold-search t))
(when (file-exists-p file)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(re-search-forward "package: \\(.*\\)")
(setq ess-developer--pack-name (match-string 1))))))))
(defun ess-developer-activate-in-package (&optional package all)
"Activate developer if current file is part of a package which
is registered in `ess-developer-packages'.
If PACKAGE is given, activate only if current file is part of the
PACKAGE, `ess-developer-packages' is ignored in this case.
If ALL is non-nil, perform activation in all R buffers.
This function does nothing if `ess-developer-activate-in-package'
is nil."
(when ess-developer-activate-in-package
(if all
(dolist (bf (buffer-list))
(with-current-buffer bf
(ess-developer-activate-in-package package)))
(let ((pack (ess-developer--get-package-name)))
(when (and buffer-file-name
pack
(not ess-developer)
(if package
(equal pack package)
(member pack ess-developer-packages)))
(ess-developer t))))))
(defun ess-developer-deactivate-in-package (&optional package all)
"Deactivate developer if current file is part of the R package.
If PACKAGE is given, deactivate only if current package is
PACKAGE.
If ALL is non-nil, deactivate in all open R buffers."
(if all
(dolist (bf (buffer-list))
(with-current-buffer bf
(ess-developer-deactivate-in-package package)))
(let ((pack (ess-developer--get-package-name)))
(when (and ess-developer
(or (null package)
(equal pack package)))
(ess-developer -1)))))
(defun ess-developer-load-package ()
"Interface to load_all function from devtools package."
(interactive)
(ess-force-buffer-current)
(let ((package (ess-developer--get-package-path)))
(unless (and package ess-developer)
;; ask only when not obvious
(setq package
(read-directory-name "Package: " package nil t nil)))
(unless (file-exists-p (expand-file-name ess-developer-root-file package))
(error "Not a valid package. No '%s' found in `%s'."
ess-developer-root-file package))
(message "Loading %s" (abbreviate-file-name package))
(ess-eval-linewise
(format ess-developer-load-package-command package))))
(defvar ess-developer nil
"Non nil in buffers where developer mode is active")
(make-variable-buffer-local 'ess-developer)
;; Since the ESSR package, this one is not needed:
;; (defun ess-developer--inject-source-maybe ()
;; ;; puting this into ESSR.R makes loading very slow
;; ;; when ESSR is a package, this should go away
;; (let ((devR-file (concat (file-name-directory ess-etc-directory)
;; "ess-developer.R")))
;; (unless (ess-boolean-command
;; "exists('.essDev_source', envir = .ESSR_Env)\n")
;; (unless (file-exists-p devR-file)
;; (error "Cannot locate 'ess-developer.R' file"))
;; (message "Injecting ess-developer code ...")
;; (ess--inject-code-from-file devR-file)
;; (unless (ess-boolean-command "exists('.essDev_source', envir = .ESSR_Env)\n")
;; (error "Could not source ess-developer.R. Please investigate the output of *ess-command-output* buffer for errors")))))
(defun ess-developer (&optional val)
"Toggle on/off `ess-developer' functionality.
If optional VAL is non-negative, turn on the developer mode. If
VAL is negative turn it off.
See also `ess-developer-packages', `ess-developer-add-package'
and `ess-developer-activate-in-package'."
(interactive)
(when (eq val t) (setq val 1))
(let ((ess-dev (if (numberp val)
(if (< val 0) nil t)
(not ess-developer))))
(if ess-dev
(progn
(run-hooks 'ess-developer-enter-hook)
(if ess-developer-packages
(message "You are developing: %s" ess-developer-packages)
(message "Developer is on (add packages with C-c C-t a)")))
(run-hooks 'ess-developer-exit-hook)
(message "%s developer is off" (if (get-buffer-process (current-buffer))
"Global"
"Local")))
(setq ess-developer ess-dev))
(force-window-update))
(defalias 'ess-toggle-developer 'ess-developer)
;;; MODELINE
(defvar ess-developer--local-indicator
'(""
(:eval
;; process has priority
(if (and (ess-process-live-p)
(ess-get-process-variable 'ess-developer))
(propertize " D" 'face 'ess-developer-indicator-face)
(if ess-developer
(propertize " d" 'face 'ess-developer-indicator-face)
"")))))
(put 'ess-developer--local-indicator 'risky-local-variable t)
(defun ess-developer-setup-modeline ()
(add-to-list 'ess--local-mode-line-process-indicator
'ess-developer--local-indicator 'append))
;;; HOOKS
(add-hook 'R-mode-hook 'ess-developer-activate-in-package)
(add-hook 'R-mode-hook 'ess-developer-setup-modeline)
(add-hook 'inferior-ess-mode-hook 'ess-developer-setup-modeline)
(provide 'ess-developer)
;;; ess-developer.el ends here