;;; essd-iw32.el --- ESS customization for ddeclients under Windows 9x/NT

;; Copyright (C) 1998--1999 Richard M. Heiberger <rmh@fisher.stat.temple.edu>
;; Copyright (C) 2000--2004 A.J. Rossini, Rich M. Heiberger, Martin
;;	Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.

;; Original Author: Richard M. Heiberger  <rmh@fisher.stat.temple.edu>
;; Created: 9 Dec 1998
;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>

;; 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.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; Code for dealing with running external processes on Windows 9x/NT
;; through ddeclient.


;;; Code:

 ; Requires and autoloads

(require 'ess-mode)
(require 'ess-inf)
(require 'ess-help)


;; C-c C-r
(defun ess-eval-region-ddeclient (start end toggle &optional message even-empty)
  "Loop through lines in region and send them to ESS via ddeclient.
The prefix argument is ignored when ddeclient is used"
  (setq inferior-ess-ddeclient
	(ess-get-process-variable
	 ess-current-process-name 'inferior-ess-ddeclient))
  (setq inferior-ess-client-name
	(ess-get-process-variable
	 ess-current-process-name 'inferior-ess-client-name))
  (setq inferior-ess-client-command
	(ess-get-process-variable
	 ess-current-process-name 'inferior-ess-client-command))
  (narrow-to-region start end)
  (beginning-of-buffer)
  (let ((beg))
    (while (or (< (point) (point-max))
	       (and (= 1 (point-max)) even-empty))
      (setq beg (point))
      (end-of-line)
      ;; call-process-region won't send over a 0-character line.
      ;; We go outside the loop to create a 1-character line " " in the
      ;; *ESS-temporary* buffer
      (if (= beg (point))  ;; do empty line outside loop
	    (ess-eval-linewise-ddeclient " " nil 'eob t)
	;;(call-process-region start end
	;;                     "ddeclient" nil nil nil "S-PLUS" "SCommand")
	(call-process-region
	 beg (point)
	 inferior-ess-ddeclient nil nil nil
	 inferior-ess-client-name inferior-ess-client-command))
      (forward-line 1))
    (widen)))

(fset 'ess-eval-region-original (symbol-function  'ess-eval-region))

(defun ess-eval-region (start end toggle &optional message)
  "Send the current region to the inferior ESS process.  This is the
MS-Windows version of `ess-eval-region'.  When used with S-Plus 4.x or
S-Plus 2000 the prefix argument is ignored; see the documentation for
`ess-eval-region-ddeclient'.  When used with other ESS programs the
prefix argument will toggle meaning of `ess-eval-visibly-p'; see the
documentation for `ess-eval-region-original'."
  (interactive "r\nP")
  (if (equal (ess-get-process-variable
	      ess-current-process-name 'inferior-ess-ddeclient)
	     (default-value 'inferior-ess-ddeclient))
      (ess-eval-region-original start end toggle message)
    (ess-force-buffer-current "Process to load into: ")
    (ess-eval-region-ddeclient start end toggle message t))
)



;;; switch between Splus by ddeclient and Splus running in an emacs buffer
(defun ess-eval-linewise-ddeclient
  (text-withtabs &optional invisibly eob even-empty)
  (save-excursion
    (set-buffer (get-buffer-create "*ESS-temporary*"))
    (ess-setq-vars-local ess-customize-alist (current-buffer))
    (erase-buffer)
    (insert text-withtabs)
    (ess-eval-region-ddeclient (point-min) (point-max) t t even-empty)))

(fset 'ess-eval-linewise-original (symbol-function  'ess-eval-linewise))

(defun ess-eval-linewise (text-withtabs &optional invisibly eob even-empty)
  (if (equal (ess-get-process-variable
	      ess-current-process-name 'inferior-ess-ddeclient)
             (default-value 'inferior-ess-ddeclient))
      (ess-eval-linewise-original text-withtabs invisibly eob even-empty)
      (ess-eval-linewise-ddeclient text-withtabs invisibly eob even-empty)))


;; C-c C-v
;;; this works for Sqpe+4 and S+4
(defun ess-display-help-on-object-ddeclient (object)
  "Display the ESS documentation for OBJECT in another window.
If prefix arg is given, forces a query of the ESS process for the help
file.  Otherwise just pops to an existing buffer if it exists."
  (ess-force-buffer-current "Process to load into: ")
  (ess-eval-linewise (concat "help(" object ")")))


(fset 'ess-display-help-on-object-original
      (symbol-function  'ess-display-help-on-object))

(defun ess-display-help-on-object (object)
  (interactive "sHelp on: ")
  (if (equal (ess-get-process-variable
	      ess-current-process-name 'inferior-ess-ddeclient)
	     (default-value 'inferior-ess-ddeclient))
      (ess-display-help-on-object-original object)
    (ess-display-help-on-object-ddeclient object))
  (widen))



;;; Alternate version of ess-load-file, required with S+4.
;;; This version sends the S-Plus command
;;;         source("filename")
;;; to S.  This version does not guarantee to save .Last.value
;;; This version does not offer alternate buffers or editing capability.

;; C-c C-l
;;; this works for Sqpe+4 and S+4
(defun ess-load-file-ddeclient (filename)
  "Load an S source file into an inferior ESS process."
  ;; (require 'ess-inf) ; (rmh) not needed in function.  require is on the file.
  (ess-make-buffer-current)
  (let ((source-buffer (get-file-buffer filename)))
    (if (ess-check-source filename)
	(error "Buffer %s has not been saved" (buffer-name source-buffer))
      ;; Find the process to load into
      (if source-buffer
	  (save-excursion
	    (set-buffer source-buffer)
	    (ess-force-buffer-current "Process to load into: ")
	    ;; (ess-check-modifications) ;;; not possible with ddeclient
	    ;; it calls ess-command which requires two-way communication
	    ;; with the S-Plus process
	    )))
    (ess-eval-linewise (format inferior-ess-load-command filename))))

(fset 'ess-load-file-original
      (symbol-function  'ess-load-file))

(defun ess-load-file (filename)
"Alternate version of `ess-load-file', required with S+4.
This version sends the S-Plus command
     source(\"filename\")
to S.  This version does not guarantee to save .Last.value
This version does not offer alternate buffers or editing capability."
     (interactive (list
		   (or
		    (and (eq major-mode 'ess-mode)
			 (buffer-file-name))
		    (expand-file-name
		     (read-file-name "Load S file: " nil nil t)))))
     (if (equal (ess-get-process-variable
		 ess-current-process-name 'inferior-ess-ddeclient)
		(default-value 'inferior-ess-ddeclient))
	 (ess-load-file-original filename)
       (ess-load-file-ddeclient filename))
     (widen))

;; C-c C-d
(defun ess-dump-object-ddeclient (object filename)
  "Dump the ESS object OBJECT into file FILENAME."
  (ess-force-buffer-current "Process to load into: ")
  (ess-eval-linewise (concat "dump('" object "','" filename "')"))
  (sleep-for 5)
  (find-file filename))


(fset 'ess-dump-object-original
      (symbol-function  'ess-dump-object))

(defun ess-dump-object (object filename)
  "Dump the ESS object OBJECT into file FILENAME."
  (if (equal (ess-get-process-variable
	      ess-current-process-name 'inferior-ess-ddeclient)
	     (default-value 'inferior-ess-ddeclient))
      (ess-dump-object-original object filename)
    (ess-dump-object-ddeclient object filename))
  (widen))




(fset 'ess-dump-object-into-edit-buffer-original
      (symbol-function  'ess-dump-object-into-edit-buffer))

(defun ess-dump-object-into-edit-buffer (object)
  "Dump the ESS object OBJECT into file FILENAME."
  (interactive
   (progn
     (ess-force-buffer-current "Process to dump from: ")
     (list (read-string "Object to edit: "))))
  (if (equal (ess-get-process-variable
	      ess-current-process-name 'inferior-ess-ddeclient)
	     (default-value 'inferior-ess-ddeclient))
      (ess-dump-object-into-edit-buffer-original object)
    (ess-dump-object-into-edit-buffer-ddeclient object))
  (widen))




(defun ess-dump-object-into-edit-buffer-ddeclient (object)
  "Edit an ESS object in its own buffer.

Without a prefix argument, this simply finds the file pointed to by
`ess-source-directory'. If this file does not exist, or if a
prefix argument is given, a dump() command is sent to the ESS process to
generate the source buffer."
  (interactive
   (progn
     (ess-force-buffer-current "Process to dump from: ")
     (ess-read-object-name "Object to edit: ")))
  (let* ((dirname (file-name-as-directory
		   (if (stringp ess-source-directory)
		       ess-source-directory
		     (save-excursion
		       (set-buffer
			(process-buffer (get-ess-process
					 ess-local-process-name)))
		       (ess-setq-vars-local ess-customize-alist)
		       (apply ess-source-directory nil)))))
	 (filename (concat dirname (format ess-dump-filename-template object)))
	 (old-buff (get-file-buffer filename)))

    ;; If the directory doesn't exist, offer to create it
    (if (file-exists-p (directory-file-name dirname)) nil
      (if (y-or-n-p	; Approved
	   (format "Directory %s does not exist. Create it? " dirname))
	  (make-directory (directory-file-name dirname))
	(error "Directory %s does not exist." dirname)))

    ;; Three options:
    ;;  (1) Pop to an existing buffer containing the file in question
    ;;  (2) Find an existing file
    ;;  (3) Create a new file by issuing a dump() command to S
    ;; Force option (3) if there is a prefix arg

    (if current-prefix-arg
	(ess-dump-object object filename)
      (if old-buff
	  (progn
	    (pop-to-buffer old-buff)
	    (message "Popped to edit buffer."))
	;; No current buffer containing desired file
	(if (file-exists-p filename)
	    (progn
	      (ess-find-dump-file-other-window filename)
	      (message "Read %s" filename))
	  ;; No buffer and no file
	  (ess-dump-object object filename))))))

(defun ess-command-ddeclient (com &optional buf)
  "ddeclient bypass of real ess-command"
  (ess-eval-linewise com))

(fset 'ess-command-original (symbol-function 'ess-command))

(defun ess-command (com &optional buf sleep)
  "This is the 'w32' version. Either calls the original `ess-command-original'
(see its doc) or `ess-command-ddeclient'."
  (interactive)
  (if buf                ;;Mar 01 2002 rmh
      (save-excursion
	(set-buffer buf)
	(setq ess-local-process-name ess-current-process-name)))
  (if (not (ess-ddeclient-p))
      (ess-command-original com buf sleep)
    (ess-force-buffer-current "Process to load into: ")
    (ess-command-ddeclient com buf)))

(provide 'ess-iw32)

 ; 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
;;; mode: outline-minor
;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
;;; End:

;;; ess-iw32.el ends here