467 lines
18 KiB
EmacsLisp
467 lines
18 KiB
EmacsLisp
;;; ess-r-package.el --- Package development mode for R.
|
||
|
||
;; Copyright (C) 2011-2015 Lionel Henry, Vitalie Spinu, A.J. Rossini, Richard
|
||
;; M. Heiberger, Martin Maechler, Kurt Hornik, Rodney Sparapani, and
|
||
;; Stephen Eglen.
|
||
|
||
;; Author: Lionel Henry, Vitalie Spinu
|
||
;; 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-utils)
|
||
|
||
(defcustom ess-r-package-auto-set-evaluation-env t
|
||
"If non-nil, evaluation env is set to package env automatically.
|
||
See also `ess-r-set-evaluation-env' and `ess-r-evaluation-env'."
|
||
:group 'ess-r-package
|
||
:type 'boolean)
|
||
|
||
(defvar-local ess-r-package--project-cache nil
|
||
"Current package info cache.
|
||
|
||
Cons cell of two strings. CAR is the package name active in the
|
||
current buffer. CDR is the path to its source directory.")
|
||
|
||
(defvar ess-r-package-library-path nil
|
||
"Default path to find packages.")
|
||
|
||
(defvar ess-r-package-root-file "DESCRIPTION"
|
||
"Presence of this file indicates the project's root.")
|
||
|
||
(defvar ess-r-package-dirs
|
||
'(("R" . 1)
|
||
("r" . 1)
|
||
("tests" . 1)
|
||
("testthat" . 2)
|
||
("inst" . 1)
|
||
("include" . 2)
|
||
("src" . 1))
|
||
"Alist of directories names and their depth in R package hierarchy.
|
||
This list is used to figure out whether the current file belongs
|
||
to an R package. If the file specified in `ess-r-package-root-file'
|
||
\(DESCRIPTION by default) is found at the presumed root directory
|
||
of the package, the current directory is considered to be part of
|
||
a R package.")
|
||
|
||
(defvar ess-r-package-source-roots
|
||
'("R" "src" "tests" "inst/include")
|
||
"List of sub-directories within R package where source files are located.
|
||
All children of these directories are also considered source
|
||
containing directories. Use `ess-r-package-source-dirs' to get
|
||
all source dirs recursively within the current package.")
|
||
|
||
|
||
;;;*;;; Package UI
|
||
|
||
(defun ess-r-package-project (&optional dir)
|
||
"Return the current package as an Emacs project instance.
|
||
A project instance is a cons cell of the project name as symbol
|
||
and the project path as string. If DIR is provided, the package
|
||
is searched from that directory instead of `default-directory'."
|
||
(if (car ess-r-package--project-cache)
|
||
ess-r-package--project-cache
|
||
(let* ((pkg-path (ess-r-package--find-package-path (or dir default-directory)))
|
||
(project (when pkg-path
|
||
(cons (ess-r-package--find-package-name pkg-path) pkg-path))))
|
||
;; Cache info for better performance on remotes
|
||
(setq-local ess-r-package--project-cache (or project (list nil)))
|
||
(when (car project)
|
||
(cons 'r-package (cdr project))))))
|
||
|
||
(defun ess-r-package-name (&optional dir)
|
||
"Return the name of the current package as a string."
|
||
;; FIXME Emacs 25.1: Use `when-let'
|
||
(let ((project (ess-r-package-project dir)))
|
||
(when project
|
||
(symbol-name (car ess-r-package--project-cache)))))
|
||
|
||
(defun ess-r-package-get-info ()
|
||
"Deprecated function to get package info.
|
||
Please use `ess-r-package-project' instead."
|
||
(let ((project (ess-r-package-project)))
|
||
(if project
|
||
(cons (ess-r-package-name) (cdr project))
|
||
(list nil))))
|
||
(make-obsolete 'ess-r-package-get-info 'ess-r-package-project "17.11")
|
||
|
||
(defun ess-r-package--all-source-dirs (dir)
|
||
(when (file-exists-p dir)
|
||
(cl-loop for f in (directory-files-and-attributes dir t "^[^.]")
|
||
if (cadr f)
|
||
append (cons (car f) (ess-r-package--all-source-dirs (car f))))))
|
||
|
||
(defun ess-r-package-source-dirs ()
|
||
"Get paths within current R package with source files.
|
||
Return nil if not in a package. Search sub-directories listed in
|
||
`ess-r-package-source-roots' are searched recursively and
|
||
return all physically present directories."
|
||
;; FIXME Emacs 25.1: Use `when-let'
|
||
(let ((pkg-root (cdr (ess-r-package-project))))
|
||
(when pkg-root
|
||
(let ((files (directory-files-and-attributes pkg-root t "^[^.]")))
|
||
(cl-loop for f in files
|
||
if (and (cadr f)
|
||
(cl-some (lambda (el) (string-match-p (concat "/" el "$") (car f)))
|
||
ess-r-package-source-roots))
|
||
append (cons (car f)
|
||
(ess-r-package--all-source-dirs (car f))))))))
|
||
|
||
(defun ess-r-package-use-dir ()
|
||
"Set process directory to current package directory."
|
||
(interactive)
|
||
(let ((dir (cdr (ess-r-package-project))))
|
||
(ess-use-dir dir)))
|
||
|
||
(defun ess-r-package-set-package ()
|
||
"Set a package for ESS r-package commands."
|
||
(interactive)
|
||
(let* ((pkg-path (read-directory-name
|
||
"Path: " (or (ess-r-package--find-package-path)
|
||
ess-r-package-library-path)
|
||
nil t))
|
||
(pkg-name (ess-r-package--find-package-name pkg-path))
|
||
(pkg-info (cons pkg-name pkg-path)))
|
||
(unless (and pkg-name pkg-path
|
||
(file-exists-p (expand-file-name ess-r-package-root-file pkg-path)))
|
||
(error "Not a valid package. No '%s' found in `%s'." ess-r-package-root-file pkg-path))
|
||
(message (format "%s selected and added to file-local variables" pkg-name))
|
||
(save-excursion
|
||
(add-file-local-variable 'ess-r-package--project-cache pkg-info))
|
||
(setq ess-r-package--project-cache pkg-info)))
|
||
|
||
(defun ess-r--select-package-name ()
|
||
(inferior-ess-r-force)
|
||
(let ((pkgs (ess-get-words-from-vector
|
||
(format "print(.packages(%s), max = 1e6)\n"
|
||
(if ess-r-prompt-for-attached-pkgs-only "FALSE" "TRUE"))))
|
||
(current-pkg (ess-r-package-name)))
|
||
(let ((env (ess-r-get-evaluation-env)))
|
||
(when env
|
||
(setq pkgs (append '("*none*") pkgs))
|
||
(when (equal env current-pkg)
|
||
(setq current-pkg "*none*"))))
|
||
(ess-completing-read "Package" pkgs nil nil nil nil current-pkg)))
|
||
|
||
(defun ess-r-package-set-namespaced-evaluation ()
|
||
(when ess-r-package-auto-set-evaluation-env
|
||
;; FIXME Emacs 25.1: Use `when-let'
|
||
(let ((pkg (ess-r-package-name)))
|
||
(when pkg
|
||
(ess-r-set-evaluation-env pkg)))))
|
||
|
||
(add-hook 'R-mode-hook 'ess-r-package-set-namespaced-evaluation)
|
||
|
||
(defun ess-r-package-send-process (command &optional msg alt default-alt)
|
||
(inferior-ess-r-force)
|
||
(let* ((pkg-info (or (ess-r-package-project)
|
||
(ess-r-package-set-package)))
|
||
(name (ess-r-package-name))
|
||
(path (concat "'" (cdr pkg-info) "'"))
|
||
(args (ess-r-command--process-alt-args alt default-alt)))
|
||
(message msg name)
|
||
(with-ess-process-buffer nil
|
||
(setq ess-r-package--project-cache ess-r-package--project-cache))
|
||
(ess-eval-linewise (format command (concat path args)))))
|
||
|
||
(defun ess-r-command--process-alt-args (alt &optional default-alt)
|
||
(let ((args (cond ((stringp alt) alt)
|
||
(alt (read-string "Arguments: " default-alt))
|
||
(t ""))))
|
||
(if (or (null args)
|
||
(string= "" args))
|
||
args
|
||
(concat ", " args))))
|
||
|
||
|
||
;;;*;;; Package Detection
|
||
|
||
(defun ess-r-package--find-package-path (&optional dir)
|
||
"Get the root of R package that contains current directory.
|
||
Root is determined by locating `ess-r-package-root-file'."
|
||
(let* ((path (cond
|
||
(dir)
|
||
((buffer-file-name)
|
||
(file-name-directory (buffer-file-name)))
|
||
(t
|
||
default-directory)))
|
||
(pkg-path
|
||
(when path
|
||
(or
|
||
;; First check current directory
|
||
(and (file-exists-p (expand-file-name ess-r-package-root-file path))
|
||
path)
|
||
;; Check for known directories in current path
|
||
(let ((current-dir (file-name-nondirectory (directory-file-name path)))
|
||
known-pkg-dir known-path presumptive-path)
|
||
(while (and path (not presumptive-path))
|
||
(setq current-dir (file-name-nondirectory (directory-file-name path)))
|
||
(if (and (setq known-pkg-dir (assoc current-dir ess-r-package-dirs))
|
||
(setq known-path (ess--parent-dir path (cdr known-pkg-dir)))
|
||
(file-exists-p (expand-file-name ess-r-package-root-file known-path)))
|
||
(setq presumptive-path known-path)
|
||
(setq path (ess--parent-dir path 1))))
|
||
presumptive-path)))))
|
||
(when pkg-path
|
||
(directory-file-name pkg-path))))
|
||
|
||
(defun ess-r-package--find-package-name (path)
|
||
(let ((file (expand-file-name ess-r-package-root-file path))
|
||
(case-fold-search t))
|
||
(when (file-exists-p file)
|
||
(with-temp-buffer
|
||
(insert-file-contents file)
|
||
(goto-char (point-min))
|
||
(when (re-search-forward "package: \\(.*\\)" nil t)
|
||
(intern (match-string 1)))))))
|
||
|
||
|
||
;;;*;;; Devtools Integration
|
||
|
||
(defun ess-r-devtools-load-package (&optional alt)
|
||
"Interface for `devtools::load_all()'."
|
||
(interactive "P")
|
||
(ess-r-package-send-process "devtools::load_all(%s)\n"
|
||
"Loading %s"
|
||
alt "recompile = TRUE"))
|
||
|
||
(defun ess-r-devtools-unload-package ()
|
||
"Interface to `devtools::unload()'."
|
||
(interactive)
|
||
(ess-r-package-send-process "devtools::unload(%s)\n"
|
||
"Unloading %s"))
|
||
|
||
(defun ess-r-devtools-check-package (&optional alt)
|
||
"Interface for `devtools::check()'."
|
||
(interactive "P")
|
||
(ess-r-package-send-process "devtools::check(%s)\n"
|
||
"Checking %s"
|
||
alt "vignettes = FALSE"))
|
||
|
||
(defun ess-r-devtools-check-package-buildwin (&optional alt)
|
||
"Interface for `devtools::buildwin()'."
|
||
(interactive "P")
|
||
(ess-r-package-send-process "devtools::build_win(%s)\n"
|
||
"Checking %s on CRAN's Windows server"))
|
||
|
||
(defun ess-r-devtools-test-package (&optional alt)
|
||
"Interface for `devtools::test()'.
|
||
When called with a non-string prefix argument (as with C-u),
|
||
check that the file name starts with `test-' and ends with
|
||
`.R'. If that is the case, use the string in-between as default
|
||
filter argument. Otherwise, use the whole base filename."
|
||
(interactive "P")
|
||
(let (file-name)
|
||
(when (and alt
|
||
(not (stringp alt))
|
||
buffer-file-name
|
||
(setq file-name (file-name-nondirectory buffer-file-name)))
|
||
(setq alt (if (string-match "test-\\([[:alnum:]]+\\)\\.[rR]" file-name)
|
||
(match-string-no-properties 1 file-name)
|
||
(file-name-base buffer-file-name)))
|
||
(setq alt (concat "\"" alt "\""))))
|
||
(ess-r-package-send-process "devtools::test(%s)\n"
|
||
"Testing %s"
|
||
alt))
|
||
|
||
(defvar ess-r-devtools-revdep-check-cmd
|
||
"local({
|
||
pkg_path <- %s
|
||
res <- devtools::revdep_check(pkg_path)
|
||
|
||
if (file.exists(file.path(pkg_path, 'revdep'))) {
|
||
save_path <- file.path(pkg_path, 'revdep')
|
||
} else {
|
||
save_path <- file.path(pkg_path, '.metadata', 'revdep')
|
||
}
|
||
devtools::revdep_check_save_summary(res, save_path)
|
||
|
||
logs_path <- file.path(save_path, 'logs')
|
||
if (!dir.exists(logs_path)) {
|
||
dir.create(logs_path)
|
||
}
|
||
devtools::revdep_check_save_logs(res, logs_path)
|
||
})
|
||
")
|
||
|
||
(defun ess-r-devtools-revdep-check-package (&optional alt)
|
||
"Interface for `devtools::revdep_check()'.
|
||
|
||
By default, the revdep summary is saved in `pkg_path/revdep' if
|
||
the directory exists, or `pkg_path/.metadata/revdep' if it
|
||
doesn't exist. The former path is the default in devtools but
|
||
will create problem if it isn't escaped in `.Rbuildignore'. On
|
||
the other hand, `.metadata' is always ignored by the R package
|
||
builder, which makes it a safe directory to store the revdep
|
||
checking results."
|
||
(interactive "P")
|
||
(ess-r-package-send-process ess-r-devtools-revdep-check-cmd
|
||
"Checking reverse dependencies of %s"
|
||
alt))
|
||
|
||
(defun ess-r-devtools-document-package (&optional alt)
|
||
"Interface for `devtools::document()'."
|
||
(interactive "P")
|
||
(ess-r-package-send-process "devtools::document(%s)\n"
|
||
"Documenting %s"
|
||
alt))
|
||
|
||
(defun ess-r-devtools-install-package (&optional alt)
|
||
"Interface to `devtools::install()'."
|
||
(interactive "P")
|
||
(ess-r-package-send-process "devtools::install(%s)\n"
|
||
"Installing %s"
|
||
alt))
|
||
|
||
(defun ess-r-devtools-install-github (&optional alt repo)
|
||
"Interface to `devtools::install_github()'.
|
||
Asks for github repository in the form of user/repo, unless REPO
|
||
is supplied. Prompts for additional arguments when called with a
|
||
prefix."
|
||
(interactive "P")
|
||
(let ((command "devtools::install_github(%s%s)")
|
||
(repo (concat "'" (or repo (read-string "User/Repo: ")) "'"))
|
||
(args (ess-r-command--process-alt-args alt "ref = ")))
|
||
(ess-eval-linewise (format command repo args))))
|
||
|
||
(defun ess-r-devtools-create-package (&optional alt)
|
||
"Interface to `devtools::create()'.
|
||
Default location is determined by `ess-r-package-library-path'."
|
||
(interactive "P")
|
||
(let* ((command "devtools::create(\"%s\")")
|
||
(default-path (expand-file-name ess-r-package-library-path))
|
||
(path (read-directory-name "Path: " default-path)))
|
||
(ess-eval-linewise (format command path))))
|
||
|
||
(defun ess-r-devtools-ask (&optional alt)
|
||
"Asks with completion for a devtools command.
|
||
When called with prefix, also asks for additional arguments."
|
||
(interactive "P")
|
||
(inferior-ess-r-force)
|
||
(let* ((devtools-funs (ess-get-words-from-vector ".ess_devtools_functions()\n"))
|
||
(fun (completing-read "Function: " devtools-funs))
|
||
(command (format "devtools::%s(%s)\n" fun "%s")))
|
||
(ess-r-package-send-process command
|
||
(format "Running %s" fun)
|
||
alt)))
|
||
|
||
|
||
;;;*;;; Minor Mode
|
||
|
||
(defcustom ess-r-package-auto-activate t
|
||
"If non-nil, `ess-r-package-mode' is turned on within R packages."
|
||
:group 'ess-r-package
|
||
:type 'boolean)
|
||
|
||
(defcustom ess-r-package-enter-hook nil
|
||
"Normal hook run on entering `ess-r-package-mode'."
|
||
:group 'ess-r-package
|
||
:type 'hook)
|
||
|
||
(defcustom ess-r-package-exit-hook nil
|
||
"Normal hook run on exiting `ess-r-package-mode'."
|
||
:group 'ess-r-package
|
||
:type 'hook)
|
||
|
||
(defcustom ess-r-package-mode-line
|
||
;; FIXME Emacs 25.1: Use `when-let'
|
||
'(:eval (let ((pkg-name (ess-r-package-name)))
|
||
(when pkg-name
|
||
(format " [pkg:%s]" pkg-name))))
|
||
"Mode line for ESS developer. Set this variable to nil to
|
||
disable the mode line entirely."
|
||
:group 'ess-r-package
|
||
:type 'sexp
|
||
:risky t)
|
||
|
||
(defvar ess-r-package-mode-map
|
||
(let ((ess-r-package-mode-map (make-sparse-keymap)))
|
||
(define-key ess-r-package-mode-map "\C-c\C-w" 'ess-r-package-dev-map)
|
||
ess-r-package-mode-map))
|
||
|
||
(define-minor-mode ess-r-package-mode
|
||
"Minor mode for enabling R package development features.
|
||
|
||
\\{ess-r-package-mode-map}"
|
||
:init-value nil
|
||
:keymap ess-r-package-mode-map
|
||
:lighter ess-r-package-mode-line
|
||
(cond
|
||
(ess-r-package-mode
|
||
(add-hook 'project-find-functions #'ess-r-package-project)
|
||
(run-hooks 'ess-r-package-enter-hook))
|
||
(t
|
||
(remove-hook 'project-find-functions #'ess-r-package-project)
|
||
(run-hooks 'ess-r-package-exit-hook))))
|
||
|
||
(add-hook 'after-change-major-mode-hook 'ess-r-package-auto-activate)
|
||
|
||
(defun ess-r-package-auto-activate ()
|
||
"Activate developer if current file is part of a package."
|
||
(when (and ess-r-package-auto-activate
|
||
(not (memq major-mode '(minibuffer-inactive-mode fundamental-mode)))
|
||
(or (buffer-file-name)
|
||
default-directory))
|
||
;; FIXME Emacs 25.1: Use `when-let'
|
||
(let ((pkg-info (ess-r-package-project)))
|
||
(when pkg-info
|
||
(ess-r-package-mode 1)))))
|
||
|
||
|
||
;;;*;;; Deprecated variables and functions
|
||
(defun ess-developer (&optional val)
|
||
(error "As of ESS 16.04, `ess-developer' is deprecated. Use `ess-r-set-evaluation-env' instead."))
|
||
|
||
(defalias 'ess-toggle-developer 'ess-developer)
|
||
|
||
(make-obsolete-variable 'ess-developer "Please use `ess-developer-select-package' and `ess-r-set-evaluation-env' instead." "16.04")
|
||
(make-obsolete-variable 'ess-developer-root-file "Please use `ess-r-package-root-file' instead." "16.04")
|
||
(make-obsolete-variable 'ess-developer-packages "Please use `ess-r-package-set-package' and `ess-r-set-evaluation-env' instead." "16.04")
|
||
(make-obsolete-variable 'ess-developer-load-on-add-commands "Please use `ess-r-package-set-package' and `ess-r-set-evaluation-env' instead." "16.04")
|
||
(make-obsolete-variable 'ess-developer-activate-in-package "Please use `ess-r-package-auto-activate' instead." "16.04")
|
||
(make-obsolete-variable 'ess-developer-enter-hook "Please use `ess-r-package-enter-hook' instead." "16.04")
|
||
(make-obsolete-variable 'ess-developer-exit-hook "Please use `ess-r-package-exit-hook' instead." "16.04")
|
||
|
||
|
||
(provide 'ess-r-package)
|
||
|
||
; 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-r-package.el ends here
|