;;;------------------------------------------------------------*
;;; sample init.el file for ess + XEmacs under MS Windows      *
;;;        John Fox                                            *
;;;        27 May 2008        Version 0.7.3                    *
;;;------------------------------------------------------------*

;; This file goes in the .xemacs subdirectory of your HOME directory
;;   In Windows 9x, set the HOME environment variable, e.g., set HOME=c:\
;;   In Windows NT, 2000, or XP, use location pointed to by HOMEDRIVE, HOMEPATH
;;   or set the HOME environment variable

;;;----------------------------------------------------------------------------------------------
    
    (load "ess-site")    
    
;;; configuration options:

;; change to suit

    ;; Uncomment the following line (i.e., remove the initial semicolon) if the R bin directory is not on the search path.
    ;;   Edit to reflect the location of rterm.exe (e.g., change x.y.z to your R version number, such as 2.2.1).
    
    ;; (setq inferior-R-program-name "C:/Program Files/R/R-x.y.z/bin/rterm.exe")
    
    ;; If pc-behaviour-level > 0, backspace key, marked-region replace, etc. are as in Windows. 
    ;; If pc-behaviour-level > 1, in addition Windows editing keys C-x, C-c, C-v are defined.

    (defconst pc-behaviour-level 1) ; 1 = C-x, C-c, C-v are are turned *off*

    ;; If enable-R-menus > 0, then unproblematic R menu items are enabled.
    ;; If enable-R-menus > 1, then in addition menu items that call GUI functions are enabled.
    ;;    Recommended default is 1; you can use 2 if it doesn't hang R

    (defconst enable-R-menus 1) ; 2 = all menu items enabled
    
    ;; If dedicated-R-window is t then buffers other than the R-process buffer 
    ;;   cannot be displayed in the lower window  
    
    (defconst dedicated-R-window t) ; t = dedicated window
    
    ;; if scratch-in-S-mode is t then the *scratch* buffer will be put in ESS[S] mode
    
    (defconst scratch-in-S-mode nil); nil = *scratch* buffer not in ESS[S] mode
    
    ;; if hotkeys is t then the key combinations C-l, C-p, C-r, C-f will send current line
    ;;   current paragraph, or current region, or current function to R
    
    (defconst hotkeys nil); nil = don't use hotkeys
    
    ;; if use-html-help is t then the htmlhelp option is set
    
    (defconst use-html-help t); t = use html help
    
;;;----------------------------------------------------------------------------------------------
;;; function definitions
;;; (Many of these functions aren't currently used -- kept here for future development

(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 stop-R ()
    "Interrupt R process in lower window."
    (interactive)
    (select-window win2)
    (comint-interrupt-subjob)
    (select-window win1))

(defun send-line-to-R (vis)
    "Send line to R process in lower window, position output."
    (interactive "P")
    (ess-eval-line-and-go vis)
    (comint-show-maximum-output)
    (select-window win1))    

(defun send-para-to-R (vis)
    "Send paragraph to R process in lower window, position output."
    (interactive "P")
    (ess-eval-paragraph-and-go vis)
    (comint-show-maximum-output)
    (select-window win1))    
    
(defun send-function-to-R (vis)
    "Send function to R process in lower window, position output."
    (interactive "P")
    (ess-eval-function-and-go vis)
    (comint-show-maximum-output)
    (select-window win1))    
    
(defun send-region-to-R (start end vis)
    "Send region to R process in lower window, position output."
    (interactive "r\nP")
    (ess-eval-region-and-go start end vis)
    (comint-show-maximum-output)
    (select-window win1))    
 
(defun source-to-R ()
    "Source buffer to R process lower window, position output."
    (interactive)
    (source-buffer-to-R)
    (comint-show-maximum-output)
    (select-window win1))    

(defun source-buffer-to-R ()
"Function ARGS: ()
Source the file corresponding to the source buffer into the R process buffer."
(interactive)
  (let ((filename (buffer-file-name)))
    (if (not(or (string-find filename ".r" 0)
        (string-find filename ".R" 0)
        (string-find filename ".s" 0)
        (string-find filename ".S" 0)
        (string-find filename ".q" 0)))
    (error "Can't source a non-R file or the *scratch* buffer."))
    (ess-load-file filename)
    (select-window win1)))

(defun start-R ()
"Start R process and name windows"
    (R)
    (setq win2 (selected-window))  ; win2 is on bottom
    (select-window win2)
    (if dedicated-R-window (set-window-dedicated-p win2 t)) ; window win2 dedicated to R process
    (other-window -1)
    (setq win1 (selected-window))  ; win1 is on top
    (select-window win1) ; back to win1
    (if scratch-in-S-mode (R-mode))) ; put *scratch* buffer in R mode
    
;;;----------------------------------------------------------------------------------------------

; (setq directory-sep-char ?/ )   changed at request of Keith Ponting
(setq directory-sep-char ?\\ )

;;; Add an R submenu below the ESS menu 

(defun menu-load-package ()
 "Load package from a library."
  (interactive)
  (select-window win2)
  (ess-eval-linewise 
    "{.pkg <- select.list(sort(.packages(all.available = TRUE))); if(nchar(.pkg)) library(.pkg, character.only=TRUE); rm(.pkg)}\n")
  (comint-show-maximum-output)
  (select-window win1))
        
(defun menu-install-package-CRAN ()
  "Install packages from CRAN."
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    "{.a <- CRAN.packages(); install.packages(select.list(.a[,1],,TRUE), .libPaths()[1], available=.a); rm(.a)}\n")
  (comint-show-maximum-output)
  (select-window win1))
      
(defun menu-install-package-zip ()
  "Install packages from local zip files."
  (interactive) 
  (select-window win2)
  (let ((file 
           (expand-file-name
            (read-file-name "Select zip file to install: " nil nil t))))
    (ess-eval-linewise
     (concat "install.packages('" file "', .libPaths()[1], CRAN = NULL)\n")))
  (comint-show-maximum-output)
  (select-window win1))
    
(defun menu-update-packages-CRAN ()
  "Update packages from CRAN"
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    "update.packages()\n")
  (comint-show-maximum-output)
  (select-window win1))

    ;; argonaut added help menus 4/2004

(defun menu-help-html-help ()
  "HTML Help"
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    "help.start(update=F)\n")
  (comint-show-maximum-output)
  (select-window win1))

(defun menu-help-search-help ()
  "Search help..."
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    ".ans <- winDialogString('Search help', ''); if (!is.null(.ans) && (.ans != '')) help.search(.ans) else rm(.ans)\n")
  (comint-show-maximum-output)
  (select-window win1))

(defun menu-help-R-functions ()
  "R functions(text)..."
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    ".ans <- winDialogString('Help on', ''); if (!is.null(.ans) && (.ans != '')) help(.ans) else rm(.ans)\n")
  (comint-show-maximum-output)
  (select-window win1))
  
(defun menu-help-apropos ()
  "Apropos..."
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    ".ans <- winDialogString('Apropos', ''); if (!is.null(.ans) && (.ans != '')) apropos(.ans) else rm(.ans)\n")
  (comint-show-maximum-output)
  (select-window win1))

    ;; the following two menu items were contributed by Henric Nilsson
    
(defun menu-install-package-BIOC ()
  "Install packages from Bioconductor."
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    "{.a <- CRAN.packages(CRAN=getOption(\"BIOC\")); install.packages(select.list(.a[,1],,TRUE), .libPaths()[1], available=.a, CRAN=getOption(\"BIOC\")); rm(.a)}\n")
  (comint-show-maximum-output)
  (select-window win1))

(defun menu-update-packages-BIOC ()
  "Update packages from Bioconductor"
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    "update.packages(CRAN=getOption(\"BIOC\"))\n")
  (comint-show-maximum-output)
  (select-window win1))


(defun menu-remove-all-objects ()
  "Remove all R objects"
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    ".ans <- winDialog('yesno', 'Are you sure?'); if (.ans == 'YES') rm(list=ls(all=TRUE)) else rm(.ans)\n")
  (comint-show-maximum-output)
  (select-window win1))
  
(defun menu-list-objects ()
  "List R objects"
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    "ls()")
  (comint-show-maximum-output)
  (select-window win1))
  
(defun menu-display-path ()
  "Display R path"
  (interactive)
  (select-window win2)
  (ess-eval-linewise
    "search()")
  (comint-show-maximum-output)
  (select-window win1))
   
(defun menu-source-R-code ()
  "Source a file into R."
  (interactive) 
  (select-window win2)
  (let ((file
           (expand-file-name
            (read-file-name "Select file to source: " nil nil t))))
    (ess-eval-linewise
     (concat "source('" file "')\n")))
  (comint-show-maximum-output)
  (select-window win1))

(defun menu-save-workspace ()
  "Save a workspace as a file."
  (interactive) 
  (select-window win2)
  (let ((file 
           (expand-file-name
            (read-file-name "File containing workspace: " nil nil nil ".RData"))))
    (ess-eval-linewise
     (concat "save.image('" file "')\n")))
  (comint-show-maximum-output)
  (select-window win1))
  
(defun menu-load-workspace ()
  "Load a workspace into R."
  (interactive) 
  (select-window win2)
  (let ((file 
           (expand-file-name
            (read-file-name "File containing workspace: " nil nil t))))
    (ess-eval-linewise
     (concat "load('" file "')\n")))
  (comint-show-maximum-output)
  (select-window win1))

(defun menu-change-directory ()
  "Change working directory."
  (interactive) 
  (select-window win2)
  (let ((file
           (expand-file-name
        (read-directory-name "Change working directory to: "  ))))
    (if (not (equalp file "Quit")) 
      (ess-eval-linewise
        (concat "setwd('" file "')\n"))))
  (comint-show-maximum-output)
  (select-window win1))

(defun menu-quit-R-and-save ()
  "quit R saving workspace"
  (interactive)
  (select-window win2)
  (ess-eval-linewise "quit('yes')\n")
  (sleep-for 1)
  (select-window win1)
  (save-buffers-kill-emacs))

(defun menu-quit-R ()
  "quit R without saving workspace"
  (interactive)
  (select-window win2)
  (ess-eval-linewise "quit('no')\n")
  (sleep-for 1)
  (select-window win1)
  (save-buffers-kill-emacs))

    
(defun R-menu ()
"Hook to install R menu and sub-menus"
  (add-menu-item '("ESS" "R") "Interrupt computation" 'stop-R
    (> enable-R-menus 0))
  (add-menu-item '("ESS" "R" "File") "Source R code ..." 'menu-source-R-code 
    (> enable-R-menus 0) "Eval and Go")
  (add-menu-item '("ESS" "R" "File") "Save workspace ..." 'menu-save-workspace 
    (> enable-R-menus 0))
  (add-menu-item '("ESS" "R" "File") "Load workspace ..." 'menu-load-workspace 
    (> enable-R-menus 0))
  (add-menu-item '("ESS" "R" "File") "Change R directory ..." 'menu-change-directory 
    (> enable-R-menus 0))
  (add-menu-item '("ESS" "R" "Packages") "Load package ..." 'menu-load-package 
    (> enable-R-menus 1))
  (add-menu-item '("ESS" "R" "Packages") "Install packages from CRAN ..." 'menu-install-package-CRAN 
    (> enable-R-menus 1))

;; argonaut added 4/2004
  (add-menu-item '("ESS" "R" "Help") "Html Help" 'menu-help-html-help 
    (> enable-R-menus 0))
  (add-menu-item '("ESS" "R" "Help") "Search help..." 'menu-help-search-help 
    (> enable-R-menus 1))
  (add-menu-item '("ESS" "R" "Help") "R functions(text)..." 'menu-help-R-functions 
    (> enable-R-menus 1))
  (add-menu-item '("ESS" "R" "Help") "Apropos..." 'menu-help-apropos 
    (> enable-R-menus 1))
;;
  (add-menu-item '("ESS" "R" "Packages") "Install packages from Bioconductor ..." 'menu-install-package-BIOC 
    (> enable-R-menus 1))
  (add-menu-item '("ESS" "R" "Packages") "Install packages from local zip files ..." 'menu-install-package-zip 
    (> enable-R-menus 1))
  (add-menu-item '("ESS" "R" "Packages") "Update packages from CRAN" 'menu-update-packages-CRAN 
    (> enable-R-menus 0))
  (add-menu-item '("ESS" "R" "Packages") "Update packages from Bioconductor" 'menu-update-packages-BIOC 
    (> enable-R-menus 0)) 
  (add-menu-item '("ESS" "R" "Misc.") "Remove all objects" 'menu-remove-all-objects 
    (> enable-R-menus 1))
  (add-menu-item '("ESS" "R" "Misc.") "List objects" 'menu-list-objects 
    (> enable-R-menus 0))
  (add-menu-item '("ESS" "R" "Misc.") "Display path" 'menu-display-path 
    (> enable-R-menus 0))
  (delete-menu-item '("ESS" "----")) ; necessary to avoid extra separating lines
  (add-menu-button '("ESS") "----" "R")
  (add-menu-item '("File" "Exit R/XEmacs") "Quit saving R workspace" 'menu-quit-R-and-save 
    (> enable-R-menus 0))
  (add-menu-item '("File" "Exit R/XEmacs") "Just quit" 'menu-quit-R 
    (> enable-R-menus 0))
  (delete-menu-item '("File" "----")) ; necessary to avoid extra separating lines
  (add-menu-button '("File") "----" "Exit R/XEmacs"))

(add-hook 'ess-mode-hook 'R-menu)

;;; some customizations

(setq inferior-ess-same-window nil)

(defconst R-editor "winclient.exe")  ; emacs client process

;;; (defconst initial-scratch-message nil) ; empty *scratch* buffer

(defconst startup-message-timeout 1) ; display the splash frame very briefly

(setq frame-title-format "%S: %f") ; show path along with file name

(setq ess-ask-for-ess-directory nil) ; do not prompt for directory

;; the following adds to the mode association list to treat .Rhistory files as R source files

(setq auto-mode-alist
  (append
   '(("\\.[rR]history\\'" . R-mode))
   auto-mode-alist))

;;; the following section makes XEmacs behave more like a Windows editor
;;; in ess and inferior-ess modes

(defun pc-on ()
"Turn on innocuous pc editing behaviours"
  (require 'pending-del)  
  (pending-delete-mode t) ; can type over or delete selected text
  (require 's-region)
  (s-region-bind-cua)) ; some Windows editing keys

(if (> pc-behaviour-level 0)
    (progn
      (define-key ess-mode-map [delete] 'delete-char) ; delete key deletes character under cursor
      (define-key inferior-ess-mode-map [delete] 'delete-char) ; delete key deletes character under cursor
      (add-hook 'ess-mode-hook 'pc-on) ; innocuous Windows editing behaviours
      (add-hook 'inferior-ess-mode-hook 'pc-on)))
    
(if (> pc-behaviour-level 1) ; define Windows editing keys
    (progn
      (define-key ess-mode-map "\C-x" 'toolbar-cut)
      (define-key ess-mode-map "\C-c" 'toolbar-copy)
      (define-key ess-mode-map "\C-v" 'toolbar-paste)
      (define-key inferior-ess-mode-map "\C-x" 'toolbar-cut)
      (define-key inferior-ess-mode-map "\C-c" 'toolbar-copy)
      (define-key inferior-ess-mode-map "\C-v" 'toolbar-paste)))
      
(if hotkeys ; define hotkeys
   (progn
     (define-key ess-mode-map "\C-l" 'send-line-to-R)
     (define-key ess-mode-map "\C-p" 'send-para-to-R)
     (define-key ess-mode-map "\C-r" 'send-region-to-R)
     (define-key ess-mode-map "\C-f" 'send-function-to-R)))

;;; use HTML help if use-html-help is t

(defun set-html-help ()
"Use HTML help"
    (ess-eval-linewise "options(chmhelp=FALSE)")
    (sit-for 1)
    (ess-eval-linewise "options(htmlhelp=TRUE)")
    (sit-for 1))
    
(if use-html-help
    (add-hook 'ess-post-run-hook 'set-html-help))

(start-R)