;;; ess-rutils.el --- R functions and keybindings to use in iESS.

;; Author:       Sebastian Luque <sluque@gmail.com>
;; Created:      Thu Nov 10 02:20:36 2004 (UTC)
;; Last-Updated: 2013-09-22T16:08:47+0000
;;           By: Sebastian P. Luque
;; Version: $Id$

;; Copyright (c) 2005-2013 Sebastian P. Luque

;; This program 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 3, or (at your option)
;; any later version.
;; This program 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
;; https://www.r-project.org/Licenses/

;;; Commentary:

;; This library provides key bindings for performing basic R functions,
;; such as loading and managing packages, as well as object manipulation
;; (listing, viewing, and deleting), and an alternative to RSiteSearch()
;; that uses the browse-url function.  Load the library with the method you
;; prefer (e.g. M-x load-file), but the easiest is probably to: a) make
;; sure your load-path variable includes the directory where ess-rutils.el
;; resides, and b) include (require 'ess-rutils) statement in your
;; ~/.emacs.
;;
;; Usage:
;;
;; Once R is started with M-x R, you should have the key bindings defined
;; at the end of this file working in your iESS process buffers.  Simply
;; type the desired key binding.
;;
;; Acknowledgements:
;;
;; I am grateful to John Fox for having written his init.el file for
;; XEmacs, which motivated this Emacs alternative.  I wanted to add some
;; object management comforts and came across Stephen Eglen's
;; ess-rdired.el, which provides a lot of these.  ess-rutils.el builds upon
;; on a *lot* of ideas from ess-rdired.el.

;; TODO: Refactor and remove byte-compile-warnings file-local variable.
;; TODO: This should be more tightly integrated with ess-r-mode and ESSR.
;; TODO: Should be active in ess-r-mode not only ess-inf
;; TODO: Both S level Utils and this package's Rutils are in the menu; confusing and inconvenient.
(defvar pkg)

;;; Code:

;; Autoloads and requires
(require 'ess-r-mode)
(require 'ess-rdired)

(defvar ess-rutils-buf "*R temp*"
  "Name of temporary R buffer.")

(defvar ess-rutils-mode-map nil
  "Keymap for the *R temp* buffer.")

(unless ess-rutils-mode-map
  (setq ess-rutils-mode-map (make-sparse-keymap))
  (define-key ess-rutils-mode-map "l" 'ess-rutils-loadpkg)
  (define-key ess-rutils-mode-map "i" 'ess-rutils-mark-install)
  (define-key ess-rutils-mode-map "I" 'ess-rutils-install)
  (define-key ess-rutils-mode-map "u" 'ess-rutils-unmark)
  (define-key ess-rutils-mode-map "q" 'ess-rutils-quit)
  (define-key ess-rutils-mode-map "?" 'ess-rutils-help))

(defun ess-rutils-mode ()
  "Major mode for output from `ess-rutils-local-pkgs' and `ess-rutils-repos-pkgs'.
Useful bindings to handle package loading and installing.
\\{ess-rutils-mode-map}"
  (kill-all-local-variables)
  (use-local-map ess-rutils-mode-map)
  (setq major-mode 'ess-rutils-mode)
  (setq mode-name (concat "R utils " ess-local-process-name)))

(defun ess-rutils-local-pkgs ()
  "List all packages in all libraries."
  (interactive)
  (if (get-buffer ess-rutils-buf)
      (progn
        (set-buffer ess-rutils-buf)
        (setq buffer-read-only nil)))
  (ess-execute
   "writeLines(paste('  ', sort(.packages(all.available=TRUE)), sep=''))"
   nil
   (substring ess-rutils-buf 1 (- (length ess-rutils-buf) 1)))
  (pop-to-buffer ess-rutils-buf)
  (save-excursion
    (beginning-of-line) (open-line 1)
    (insert "**Available packages in all local R libraries**"))
  (setq buffer-read-only t)
  (ess-rutils-mode)
  (if (fboundp 'fit-frame)
      (fit-frame)))

(defun ess-rutils-namepkg ()
  "Return name of the package on current line."
  (save-excursion
    (beginning-of-line)
    (if (looking-at "*")
        nil
      (forward-char 2)
      (let (beg)
        (setq beg (point))
        (end-of-line) ;assume package names are separated by newlines.
        (buffer-substring-no-properties beg (point))))))

(defun ess-rutils-loadpkg ()
  "Load package from a library."
  (interactive)
  (let ((oklocal nil))
    (save-excursion
      (goto-char (point-min))
      (if (search-forward "libraries**" nil t)
          (setq oklocal t)))
    (if oklocal
        (progn
          (setq pkg (ess-rutils-namepkg))
          (ess-execute (concat "library('" pkg "', character.only=TRUE)")
                       'buffer))
      nil)))

(defun ess-rutils-repos-pkgs ()
  "List available packages.
Use the repositories as listed by getOptions(\"repos\") in the
current R session."
  (interactive)
  (if (get-buffer ess-rutils-buf)
      (progn
        (set-buffer ess-rutils-buf)
        (setq buffer-read-only nil)))
  (ess-execute (concat "writeLines(paste('  \"', "
                       "rownames(available.packages()), '\"', sep=''))")
               nil
               (substring ess-rutils-buf 1 (- (length ess-rutils-buf) 1)))
  (pop-to-buffer ess-rutils-buf)
  (save-excursion
    (kill-line 5)
    (insert "**packages available to install**\n"))
  (setq buffer-read-only t)
  (ess-rutils-mode)
  (if (fboundp 'fit-frame)
      (fit-frame)))

(defun ess-rutils-mark-install (arg)
  "Mark the current package for installing.
ARG lines to mark is passed to `ess-rutils-mark'."
  (interactive "p")
  ;; if this is not an install package buffer return nil.
  (let ((okmark nil))
    (save-excursion
      (goto-char (point-min))
      (if (search-forward "install**" nil t)
          (setq okmark t)))
    (if okmark
        (ess-rutils-mark "I" arg)
      nil)))

(defun ess-rutils-unmark (arg)
  "Unmark the packages, passing ARG lines to unmark to `ess-rutils-mark'."
  (interactive "p")
  (ess-rutils-mark " " arg))

;; The next two functions almost verbatim from ess-rdired.el.
(defun ess-rutils-mark (mark-char arg)
  "Use MARK-CHAR to mark package on current line, or next ARG lines."
  ;; If we are on first line, mark all lines.
  (let ((buffer-read-only nil)
        move)
    (if (eq (point-min)
            (save-excursion (beginning-of-line) (point)))
        (progn
          ;; we are on first line, so make a note of point, and count
          ;; how many objects we want to delete.  Then at end of defun,
          ;; restore point.
          (setq move (point))
          (forward-line 1)
          (setq arg (count-lines (point) (point-max)))))
    (while (and (> arg 0) (not (eobp)))
      (setq arg (1- arg))
      (beginning-of-line)
      (progn
        (insert mark-char)
        (delete-char 1)
        (forward-line 1)))
    (if move
        (goto-char move))))

(defun ess-rutils-install ()
  "Install all packages flagged for installation, and return to the iESS buffer.
User is asked for confirmation."
  (interactive)
  (let ((inst "install.packages(c(")
        (count 0))
    (save-excursion
      (goto-char (point-min))
      (forward-line)
      ;; as long as number of lines between buffer start and point is smaller
      ;; than the total number of lines in buffer, go to the beginning of the
      ;; line, check if line is flagged, and if it is, advance the counter by
      ;; one, create the root of install function, add the package name,
      ;; insert a comma, and move forward a line.
      (while (< (count-lines (point-min) (point))
                (count-lines (point-min) (point-max)))
        (beginning-of-line)
        (if (looking-at "^I ")
            (setq count (1+ count)
                  inst (concat inst (ess-rutils-namepkg) ", " )))
        (forward-line 1)))
    (if (> count 0)                     ;found packages to install
        (progn
          ;; Fix the install function created before and close it.
          (setq inst (concat
                      (substring inst 0 (- (length inst) 2)) "))"))
          ;;
          (if (yes-or-no-p (format "Install %d %s " count
                                   (if (> count 1) "packages" "package")))
              (progn
                (ess-execute inst 'buffer)
                (ess-rutils-quit))))
      ;; else nothing to install
      (message "no packages flagged to install"))))

(defun ess-rutils-update-pkgs (lib repos)
  "Update packages in library LIB and repos REPOS.
Defaults are the first element returned by .libPaths() for LIB,
and the repository named CRAN returned by getOption(\"repos\")
for REPOS. This also uses checkBuilt=TRUE to rebuild installed
packages if needed."
  (interactive "DPath to library to update: \nsrepos: ")
  (if (string= "" lib)
      (setq lib
            (car (ess-get-words-from-vector
                  "as.character(.libPaths())\n"))))
  (if (string= "" repos)
      (setq repos
            (car (ess-get-words-from-vector
                  "as.character(getOption(\"repos\")[\"CRAN\"])\n"))))
  (ess-execute (concat "update.packages(lib.loc='"
                       lib "', repos='" repos
                       "', ask=FALSE, checkBuilt=TRUE)") 'buffer))

(defun ess-rutils-apropos (string)
  "Search for STRING using apropos."
  (interactive "sApropos search for? ")
  (if (get-buffer ess-rutils-buf)
      (progn
        (set-buffer ess-rutils-buf)
        (setq buffer-read-only nil)))
  (ess-execute (concat "apropos('" string "')")
               nil
               (substring ess-rutils-buf 1 (- (length ess-rutils-buf) 1)))
  (pop-to-buffer ess-rutils-buf)
  (setq buffer-read-only t)
  (ess-rutils-mode))

(defun ess-rutils-rm-all ()
  "Remove all R objects."
  (interactive)
  (if (y-or-n-p "Delete all objects? ")
      (ess-execute "rm(list=ls())" 'buffer)))

(defun ess-rutils-load-wkspc (file)
  "Load workspace FILE into R."
  (interactive "fFile with workspace to load: ")
  (ess-execute (concat "load('" file "')") 'buffer))

(defun ess-rutils-save-wkspc (file)
  "Save FILE workspace.
File extension not required."
  (interactive "FSave workspace to file (no extension): ")
  (ess-execute (concat "save.image('" file ".RData')") 'buffer))

(defun ess-rutils-quit ()
  "Kill the ess-rutils buffer and return to the iESS buffer."
  (interactive)
  (ess-switch-to-end-of-ESS)
  (kill-buffer ess-rutils-buf))

(defun ess-rutils-html-docs (&optional remote)
  "Use `browse-url' to navigate R html documentation.
Documentation is produced by a modified help.start(), that
returns the URL produced by GNU R's http server. If called with a
prefix, the modified help.start() is called with update=TRUE. The
optional REMOTE argument should be a string with a valid URL for
the 'R_HOME' directory on a remote server (defaults to NULL)."
  (interactive)
  (let* ((update (if current-prefix-arg "update=TRUE" "update=FALSE"))
         (remote (if (or (and remote (not (string= "" remote))))
                     (concat "remote=" remote) "remote=NULL"))
         (rhtml (format ".ess_help_start(%s, %s)\n" update remote))
         (tmpbuf (get-buffer-create "**ess-rutils-mode**")))
    (ess-command rhtml tmpbuf)
    (set-buffer tmpbuf)
    (let* ((begurl (search-backward "http://"))
           (endurl (search-forward "index.html"))
           (url (buffer-substring-no-properties begurl endurl)))
      (browse-url url))
    (kill-buffer tmpbuf)))

(defun ess-rutils-rsitesearch (string)
  "Search the R archives for STRING, and show results using `browse-url'.
If called with a prefix, options are offered (with completion)
for matches per page, sections of the archives to search,
displaying results in long or short formats, and sorting by any
given field. Options should be separated by value of
`crm-default-separator'."
  (interactive "sSearch string: ")
  (let ((site "https://search.r-project.org/cgi-bin/namazu.cgi?query=")
        (okstring (replace-regexp-in-string " +" "+" string)))
    (if current-prefix-arg
        (let ((mpp (concat
                    "&max="
                    (completing-read
                     "Matches per page: "
                     '(("20" 1) ("30" 2) ("40" 3) ("50" 4) ("100" 5)))))
              (format (concat
                       "&result="
                       (completing-read
                        "Format: " '(("normal" 1) ("short" 2))
                        nil t "normal" nil "normal")))
              (sortby (concat
                       "&sort="
                       (completing-read
                        "Sort by: "
                        '(("score" 1) ("date:late" 2) ("date:early" 3)
                          ("field:subject:ascending" 4)
                          ("field:subject:decending" 5)
                          ("field:from:ascending" 6) ("field:from:decending" 7)
                          ("field:size:ascending" 8) ("field:size:decending" 9))
                        nil t "score" nil "score")))
              (restrict (concat
                         "&idxname="
                         (mapconcat
                          'identity
                          (completing-read-multiple
                           "Limit search to: "
                           '(("Rhelp02a" 1) ("functions" 2)
                             ("docs" 3) ("Rhelp01" 4))
                           nil t "Rhelp02a,functions,docs" nil
                           "Rhelp02a,functions,docs") "&idxname="))))
          (browse-url (concat site okstring mpp format sortby restrict)))
      (browse-url (concat site okstring "&max=20&result=normal&sort=score"
                          "&idxname=Rhelp02a&idxname=functions&idxname=docs")))))

(defun ess-rutils-help ()
  "Show help on `ess-rutils-mode'."
  (interactive)
  (describe-function 'ess-rutils-mode))

(defun ess-rutils-help-search (string)
  "Search for STRING using help.search()."
  (interactive "sString to search for? ")
  (if (get-buffer ess-rutils-buf)
      (progn
        (set-buffer ess-rutils-buf)
        (setq buffer-read-only nil)))
  (ess-execute (concat "help.search('" string "')")
               nil
               (substring ess-rutils-buf 1 (- (length ess-rutils-buf) 1)))
  (pop-to-buffer ess-rutils-buf)
  (setq buffer-read-only t)
  (ess-rutils-mode))

;; Customizable variable to allow ess-rutils-keys to activate default key bindings.
;; Suggested by Richard M. Heiberger.
(defcustom ess-rutils-keys t
  "Non-nil means activate ess-rutils keybindings and menu."
  :group 'ess-R
  :type 'boolean)

;; Keybindings
(defun ess-rutils-keys ()
  "Provide key bindings."
  (interactive)
  (when ess-rutils-keys
    (define-key inferior-ess-mode-map [(control c) (control \.) (l)]
      'ess-rutils-local-pkgs)
    (define-key inferior-ess-mode-map [(control c) (control \.) (r)]
      'ess-rutils-repos-pkgs)
    (define-key inferior-ess-mode-map [(control c) (control \.) (u)]
      'ess-rutils-update-pkgs)
    (define-key inferior-ess-mode-map [(control c) (control \.) (a)]
      'ess-rutils-apropos)
    (define-key inferior-ess-mode-map [(control c) (control \.) (m)]
      'ess-rutils-rm-all)
    (define-key inferior-ess-mode-map [(control c) (control \.) (o)]
      'ess-rdired)
    (define-key inferior-ess-mode-map [(control c) (control \.) (w)]
      'ess-rutils-load-wkspc)
    (define-key inferior-ess-mode-map [(control c) (control \.) (s)]
      'ess-rutils-save-wkspc)
    (define-key inferior-ess-mode-map [(control c) (control \.) (d)]
      'ess-change-directory)
    (define-key inferior-ess-mode-map [(control c) (control \.) (H)]
      'ess-rutils-html-docs)))

(easy-menu-define ess-rutils-mode-menu inferior-ess-mode-menu
  "Submenu of `inferior-ess-mode' to use with RUtils."
  '("RUtils"
    ["Manage objects"          ess-rdired               t]
    ["Remove objects"          ess-rutils-rm-all        t]
    "------"
    ["Local packages"           ess-rutils-local-pkgs   t]
    ["Packages in repositories" ess-rutils-repos-pkgs   t]
    ["Update packages"          ess-rutils-update-pkgs  t]
    "------"
    ["Load workspace"           ess-rutils-load-wkspc   t]
    ["Save workspace"           ess-rutils-save-wkspc   t]
    ["Change directory"        ess-change-directory     t]
    "------"
    ["Browse HTML"             ess-rutils-html-docs     t]
    ["Apropos"                 ess-rutils-apropos       t]))

(easy-menu-add-item inferior-ess-mode-menu nil ess-rutils-mode-menu "Utils")
(add-hook 'inferior-ess-mode-hook 'ess-rutils-keys)

(make-obsolete 'ess-rutils-rhtml-fn "overwrite .ess_help_start instead." "ESS 18.10")

(provide 'ess-rutils)

;;; ess-rutils.el ends here

;; Local Variables:
;; byte-compile-warnings: (not lexical)
;; End: