cgit.sxemacs.org Git - packages/blob - xemacs-packages/ess/lisp/ess-iw32.el

   1 ;;; essd-iw32.el --- ESS customization for ddeclients under Windows 9x/NT
   2
   3 ;; Copyright (C) 1998--1999 Richard M. Heiberger <rmh@fisher.stat.temple.edu>
   4 ;; Copyright (C) 2000--2004 A.J. Rossini, Rich M. Heiberger, Martin
   5 ;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
   6
   7 ;; Original Author: Richard M. Heiberger  <rmh@fisher.stat.temple.edu>
   8 ;; Created: 9 Dec 1998
   9 ;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
  10
  11 ;; This file is part of ESS
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; This file is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Code for dealing with running external processes on Windows 9x/NT
  30 ;; through ddeclient.
  31
  32
  33 ;;; Code:
  34
  35 \f ; Requires and autoloads
  36
  37 (require 'ess-mode)
  38 (require 'ess-inf)
  39 (require 'ess-help)
  40
  41
  42 ;; C-c C-r
  43 (defun ess-eval-region-ddeclient (start end toggle &optional message even-empty)
  44   "Loop through lines in region and send them to ESS via ddeclient.
  45 The prefix argument is ignored when ddeclient is used"
  46   (setq inferior-ess-ddeclient
  47         (ess-get-process-variable
  48          ess-current-process-name 'inferior-ess-ddeclient))
  49   (setq inferior-ess-client-name
  50         (ess-get-process-variable
  51          ess-current-process-name 'inferior-ess-client-name))
  52   (setq inferior-ess-client-command
  53         (ess-get-process-variable
  54          ess-current-process-name 'inferior-ess-client-command))
  55   (narrow-to-region start end)
  56   (beginning-of-buffer)
  57   (let ((beg))
  58     (while (or (< (point) (point-max))
  59                (and (= 1 (point-max)) even-empty))
  60       (setq beg (point))
  61       (end-of-line)
  62       ;; call-process-region won't send over a 0-character line.
  63       ;; We go outside the loop to create a 1-character line " " in the
  64       ;; *ESS-temporary* buffer
  65       (if (= beg (point))  ;; do empty line outside loop
  66             (ess-eval-linewise-ddeclient " " nil 'eob t)
  67         ;;(call-process-region start end
  68         ;;                     "ddeclient" nil nil nil "S-PLUS" "SCommand")
  69         (call-process-region
  70          beg (point)
  71          inferior-ess-ddeclient nil nil nil
  72          inferior-ess-client-name inferior-ess-client-command))
  73       (forward-line 1))
  74     (widen)))
  75
  76 (fset 'ess-eval-region-original (symbol-function  'ess-eval-region))
  77
  78 (defun ess-eval-region (start end toggle &optional message)
  79   "Send the current region to the inferior ESS process.  This is the
  80 MS-Windows version of `ess-eval-region'.  When used with S-Plus 4.x or
  81 S-Plus 2000 the prefix argument is ignored; see the documentation for
  82 `ess-eval-region-ddeclient'.  When used with other ESS programs the
  83 prefix argument will toggle meaning of `ess-eval-visibly-p'; see the
  84 documentation for `ess-eval-region-original'."
  85   (interactive "r\nP")
  86   (if (equal (ess-get-process-variable
  87               ess-current-process-name 'inferior-ess-ddeclient)
  88              (default-value 'inferior-ess-ddeclient))
  89       (ess-eval-region-original start end toggle message)
  90     (ess-force-buffer-current "Process to load into: ")
  91     (ess-eval-region-ddeclient start end toggle message t))
  92 )
  93
  94
  95
  96 ;;; switch between Splus by ddeclient and Splus running in an emacs buffer
  97 (defun ess-eval-linewise-ddeclient
  98   (text-withtabs &optional invisibly eob even-empty)
  99   (save-excursion
 100     (set-buffer (get-buffer-create "*ESS-temporary*"))
 101     (ess-setq-vars-local ess-customize-alist (current-buffer))
 102     (erase-buffer)
 103     (insert text-withtabs)
 104     (ess-eval-region-ddeclient (point-min) (point-max) t t even-empty)))
 105
 106 (fset 'ess-eval-linewise-original (symbol-function  'ess-eval-linewise))
 107
 108 (defun ess-eval-linewise (text-withtabs &optional invisibly eob even-empty)
 109   (if (equal (ess-get-process-variable
 110               ess-current-process-name 'inferior-ess-ddeclient)
 111              (default-value 'inferior-ess-ddeclient))
 112       (ess-eval-linewise-original text-withtabs invisibly eob even-empty)
 113       (ess-eval-linewise-ddeclient text-withtabs invisibly eob even-empty)))
 114
 115
 116 ;; C-c C-v
 117 ;;; this works for Sqpe+4 and S+4
 118 (defun ess-display-help-on-object-ddeclient (object)
 119   "Display the ESS documentation for OBJECT in another window.
 120 If prefix arg is given, forces a query of the ESS process for the help
 121 file.  Otherwise just pops to an existing buffer if it exists."
 122   (ess-force-buffer-current "Process to load into: ")
 123   (ess-eval-linewise (concat "help(" object ")")))
 124
 125
 126 (fset 'ess-display-help-on-object-original
 127       (symbol-function  'ess-display-help-on-object))
 128
 129 (defun ess-display-help-on-object (object)
 130   (interactive "sHelp on: ")
 131   (if (equal (ess-get-process-variable
 132               ess-current-process-name 'inferior-ess-ddeclient)
 133              (default-value 'inferior-ess-ddeclient))
 134       (ess-display-help-on-object-original object)
 135     (ess-display-help-on-object-ddeclient object))
 136   (widen))
 137
 138
 139
 140 ;;; Alternate version of ess-load-file, required with S+4.
 141 ;;; This version sends the S-Plus command
 142 ;;;         source("filename")
 143 ;;; to S.  This version does not guarantee to save .Last.value
 144 ;;; This version does not offer alternate buffers or editing capability.
 145
 146 ;; C-c C-l
 147 ;;; this works for Sqpe+4 and S+4
 148 (defun ess-load-file-ddeclient (filename)
 149   "Load an S source file into an inferior ESS process."
 150   ;; (require 'ess-inf) ; (rmh) not needed in function.  require is on the file.
 151   (ess-make-buffer-current)
 152   (let ((source-buffer (get-file-buffer filename)))
 153     (if (ess-check-source filename)
 154         (error "Buffer %s has not been saved" (buffer-name source-buffer))
 155       ;; Find the process to load into
 156       (if source-buffer
 157           (save-excursion
 158             (set-buffer source-buffer)
 159             (ess-force-buffer-current "Process to load into: ")
 160             ;; (ess-check-modifications) ;;; not possible with ddeclient
 161             ;; it calls ess-command which requires two-way communication
 162             ;; with the S-Plus process
 163             )))
 164     (ess-eval-linewise (format inferior-ess-load-command filename))))
 165
 166 (fset 'ess-load-file-original
 167       (symbol-function  'ess-load-file))
 168
 169 (defun ess-load-file (filename)
 170 "Alternate version of `ess-load-file', required with S+4.
 171 This version sends the S-Plus command
 172      source(\"filename\")
 173 to S.  This version does not guarantee to save .Last.value
 174 This version does not offer alternate buffers or editing capability."
 175      (interactive (list
 176                    (or
 177                     (and (eq major-mode 'ess-mode)
 178                          (buffer-file-name))
 179                     (expand-file-name
 180                      (read-file-name "Load S file: " nil nil t)))))
 181      (if (equal (ess-get-process-variable
 182                  ess-current-process-name 'inferior-ess-ddeclient)
 183                 (default-value 'inferior-ess-ddeclient))
 184          (ess-load-file-original filename)
 185        (ess-load-file-ddeclient filename))
 186      (widen))
 187
 188 ;; C-c C-d
 189 (defun ess-dump-object-ddeclient (object filename)
 190   "Dump the ESS object OBJECT into file FILENAME."
 191   (ess-force-buffer-current "Process to load into: ")
 192   (ess-eval-linewise (concat "dump('" object "','" filename "')"))
 193   (sleep-for 5)
 194   (find-file filename))
 195
 196
 197 (fset 'ess-dump-object-original
 198       (symbol-function  'ess-dump-object))
 199
 200 (defun ess-dump-object (object filename)
 201   "Dump the ESS object OBJECT into file FILENAME."
 202   (if (equal (ess-get-process-variable
 203               ess-current-process-name 'inferior-ess-ddeclient)
 204              (default-value 'inferior-ess-ddeclient))
 205       (ess-dump-object-original object filename)
 206     (ess-dump-object-ddeclient object filename))
 207   (widen))
 208
 209
 210
 211
 212 (fset 'ess-dump-object-into-edit-buffer-original
 213       (symbol-function  'ess-dump-object-into-edit-buffer))
 214
 215 (defun ess-dump-object-into-edit-buffer (object)
 216   "Dump the ESS object OBJECT into file FILENAME."
 217   (interactive
 218    (progn
 219      (ess-force-buffer-current "Process to dump from: ")
 220      (list (read-string "Object to edit: "))))
 221   (if (equal (ess-get-process-variable
 222               ess-current-process-name 'inferior-ess-ddeclient)
 223              (default-value 'inferior-ess-ddeclient))
 224       (ess-dump-object-into-edit-buffer-original object)
 225     (ess-dump-object-into-edit-buffer-ddeclient object))
 226   (widen))
 227
 228
 229
 230
 231 (defun ess-dump-object-into-edit-buffer-ddeclient (object)
 232   "Edit an ESS object in its own buffer.
 233
 234 Without a prefix argument, this simply finds the file pointed to by
 235 `ess-source-directory'. If this file does not exist, or if a
 236 prefix argument is given, a dump() command is sent to the ESS process to
 237 generate the source buffer."
 238   (interactive
 239    (progn
 240      (ess-force-buffer-current "Process to dump from: ")
 241      (ess-read-object-name "Object to edit: ")))
 242   (let* ((dirname (file-name-as-directory
 243                    (if (stringp ess-source-directory)
 244                        ess-source-directory
 245                      (save-excursion
 246                        (set-buffer
 247                         (process-buffer (get-ess-process
 248                                          ess-local-process-name)))
 249                        (ess-setq-vars-local ess-customize-alist)
 250                        (apply ess-source-directory nil)))))
 251          (filename (concat dirname (format ess-dump-filename-template object)))
 252          (old-buff (get-file-buffer filename)))
 253
 254     ;; If the directory doesn't exist, offer to create it
 255     (if (file-exists-p (directory-file-name dirname)) nil
 256       (if (y-or-n-p     ; Approved
 257            (format "Directory %s does not exist. Create it? " dirname))
 258           (make-directory (directory-file-name dirname))
 259         (error "Directory %s does not exist." dirname)))
 260
 261     ;; Three options:
 262     ;;  (1) Pop to an existing buffer containing the file in question
 263     ;;  (2) Find an existing file
 264     ;;  (3) Create a new file by issuing a dump() command to S
 265     ;; Force option (3) if there is a prefix arg
 266
 267     (if current-prefix-arg
 268         (ess-dump-object object filename)
 269       (if old-buff
 270           (progn
 271             (pop-to-buffer old-buff)
 272             (message "Popped to edit buffer."))
 273         ;; No current buffer containing desired file
 274         (if (file-exists-p filename)
 275             (progn
 276               (ess-find-dump-file-other-window filename)
 277               (message "Read %s" filename))
 278           ;; No buffer and no file
 279           (ess-dump-object object filename))))))
 280
 281 (defun ess-command-ddeclient (com &optional buf)
 282   "ddeclient bypass of real ess-command"
 283   (ess-eval-linewise com))
 284
 285 (fset 'ess-command-original (symbol-function 'ess-command))
 286
 287 (defun ess-command (com &optional buf sleep)
 288   "This is the 'w32' version. Either calls the original `ess-command-original'
 289 (see its doc) or `ess-command-ddeclient'."
 290   (interactive)
 291   (if buf                ;;Mar 01 2002 rmh
 292       (save-excursion
 293         (set-buffer buf)
 294         (setq ess-local-process-name ess-current-process-name)))
 295   (if (not (ess-ddeclient-p))
 296       (ess-command-original com buf sleep)
 297     (ess-force-buffer-current "Process to load into: ")
 298     (ess-command-ddeclient com buf)))
 299
 300 (provide 'ess-iw32)
 301
 302 \f ; Local variables section
 303
 304 ;;; This file is automatically placed in Outline minor mode.
 305 ;;; The file is structured as follows:
 306 ;;; Chapters:     ^L ;
 307 ;;; Sections:    ;;*;;
 308 ;;; Subsections: ;;;*;;;
 309 ;;; Components:  defuns, defvars, defconsts
 310 ;;;              Random code beginning with a ;;;;* comment
 311
 312 ;;; Local variables:
 313 ;;; mode: emacs-lisp
 314 ;;; mode: outline-minor
 315 ;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
 316 ;;; End:
 317
 318 ;;; ess-iw32.el ends here