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

   1 ;;; ess-mode.el --- Support for editing ESS source code
   2
   3 ;; Copyright (C) 1989-1994 Doug Bates, Ed Kademan, Frank Ritter, David Smith.
   4 ;; Copyright (C) 1997--2005 A.J. Rossini, Rich M. Heiberger, Martin
   5 ;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
   6
   7 ;; Original Author: David Smith <dsmith@stats.adelaide.edu.au>
   8 ;; Created: 7 Jan 1994
   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 editing ESS source code.
  30
  31 ;;; Code:
  32
  33 \f ; Requires and autoloads
  34
  35 (require 'ess)
  36
  37 ;;; AJR: THIS IS GROSS AND DISGUSTING (but I wrote it).
  38 ;;; MM:  and I had to add all other 'ess-eval-*** ...
  39 ;;; >>> why not just do the obvious instead of all these ? Namely,
  40 ;;; (require 'ess-inf)
  41 ;;; ------------------ ?
  42 ;;; AJR: The reason is that we ONLY need to load ess-inf for the
  43 ;;; functions which are interactive in nature.   We don't want to load
  44 ;;; it when we are only editing.
  45
  46 (autoload 'ess-mode-minibuffer-map      "ess-inf" "" nil 'keymap)
  47 (autoload 'ess-read-object-name         "ess-inf" "" nil)
  48 (autoload 'ess-list-object-completions  "ess-inf" "" nil)
  49
  50 (autoload 'ess-eval-linewise            "ess-inf" "" nil)
  51 (autoload 'ess-eval-paragraph           "ess-inf" "" nil)
  52 (autoload 'ess-eval-region              "ess-inf" "" nil)
  53 (autoload 'ess-eval-buffer              "ess-inf" "" nil)
  54 (autoload 'ess-eval-function            "ess-inf" "" nil)
  55 (autoload 'ess-eval-line                "ess-inf" "" nil)
  56 (autoload 'ess-eval-line-and-step       "ess-inf" "" nil)
  57 (autoload 'ess-eval-region-and-go       "ess-inf" "" nil)
  58 (autoload 'ess-eval-buffer-and-go       "ess-inf" "" nil)
  59 (autoload 'ess-eval-function-and-go     "ess-inf" "" nil)
  60 (autoload 'ess-eval-line-and-go         "ess-inf" "" nil)
  61
  62 (autoload 'ess-load-file                "ess-inf" "" nil)
  63 (autoload 'ess-switch-process           "ess-inf" "" nil)
  64 (autoload 'ess-switch-to-ESS            "ess-inf" "" nil)
  65 (autoload 'ess-request-a-process        "ess-inf" "" nil)
  66 (autoload 'get-ess-process              "ess-inf" "" nil)
  67 (autoload 'ess-command                  "ess-inf" "" nil)
  68 (autoload 'ess-create-temp-buffer       "ess-inf" "" nil)
  69 (autoload 'ess-display-temp-buffer      "ess-inf" "" nil)
  70 (autoload 'ess-force-buffer-current     "ess-inf" "" nil)
  71 (autoload 'ess-make-buffer-current      "ess-inf" "" nil)
  72 (autoload 'ess-modtime-gt               "ess-inf" "" nil)
  73 (autoload 'ess-object-modtime           "ess-inf" "" nil)
  74 (autoload 'ess-quit                     "ess-inf" "" nil)
  75
  76
  77 (defun ess-line-end-position (&optional N)
  78   (save-excursion
  79     (end-of-line N)
  80     (point)))
  81
  82
  83 \f ; ESS mode
  84 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  85 ;;;; In this section:
  86 ;;;;
  87 ;;;; * The major mode ess-mode
  88 ;;;; * Commands for ess-mode
  89 ;;;; * Code evaluation commands
  90 ;;;; * Indenting code and commands
  91 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  92
  93 ;;*;; Major mode definition
  94
  95 (if ess-eval-map
  96     nil
  97   (if (featurep 'xemacs)
  98       ;; Code for XEmacs
  99       (setq ess-eval-map (make-keymap))
 100     ;; else code for GNU Emacs
 101     (setq ess-eval-map (make-sparse-keymap)))
 102
 103   (define-key ess-eval-map "\C-r"    'ess-eval-region)
 104   (define-key ess-eval-map "\M-r"    'ess-eval-region-and-go)
 105   (define-key ess-eval-map "\C-b"    'ess-eval-buffer)
 106   (define-key ess-eval-map "\M-b"    'ess-eval-buffer-and-go)
 107   (define-key ess-eval-map "\C-f"    'ess-eval-function)
 108   (define-key ess-eval-map "\M-f"    'ess-eval-function-and-go)
 109   (define-key ess-eval-map "\C-x"    'ess-eval-function)
 110   (define-key ess-eval-map "\C-n"    'ess-eval-line-and-step)
 111   (define-key ess-eval-map "\C-j"    'ess-eval-line)
 112   (define-key ess-eval-map "\M-j"    'ess-eval-line-and-go))
 113
 114
 115 (if ess-mode-map
 116     nil
 117
 118   (if (featurep 'xemacs)
 119       (progn ;; Code for XEmacs
 120         (setq ess-mode-map (make-keymap))
 121         (set-keymap-parent ess-mode-map text-mode-map)) ;; was comint?!?
 122     ;; else code for GNU Emacs
 123     (setq ess-mode-map (make-sparse-keymap)))
 124
 125   ;; By popular demand:
 126   (define-key ess-mode-map "\C-m"       'newline-and-indent); = [RETURN]
 127
 128   (define-key ess-mode-map "\C-c\C-r"   'ess-eval-region)
 129   (define-key ess-mode-map "\C-c\M-r"   'ess-eval-region-and-go)
 130   (define-key ess-mode-map "\C-c\C-b"   'ess-eval-buffer)
 131   (define-key ess-mode-map "\C-c\M-b"   'ess-eval-buffer-and-go)
 132   (define-key ess-mode-map "\C-c\C-f"   'ess-eval-function)
 133   (define-key ess-mode-map "\C-c\M-f"   'ess-eval-function-and-go)
 134   (define-key ess-mode-map "\M-\C-x"    'ess-eval-function)
 135   (define-key ess-mode-map "\C-c\C-n"   'ess-eval-line-and-step)
 136   (define-key ess-mode-map "\C-c\C-j"   'ess-eval-line)
 137   (define-key ess-mode-map "\C-c\M-j"   'ess-eval-line-and-go)
 138   (define-key ess-mode-map "\M-\C-a"    'ess-beginning-of-function)
 139   (define-key ess-mode-map "\M-\C-e"    'ess-end-of-function)
 140   (define-key ess-mode-map "\C-xnd"     'ess-narrow-to-defun)
 141   (define-key ess-mode-map "\C-c\C-y"   'ess-switch-to-ESS)
 142   (define-key ess-mode-map "\C-c\C-z"   'ess-switch-to-end-of-ESS)
 143   (define-key ess-mode-map "\C-c\C-l"   'ess-load-file)
 144   (define-key ess-mode-map "\C-c\C-v"   'ess-display-help-on-object)
 145   (define-key ess-mode-map "\C-c\C-d"   'ess-dump-object-into-edit-buffer)
 146 ;(define-key ess-mode-map "\C-c5\C-d"'ess-dump-object-into-edit-buffer-other-frame)
 147   (define-key ess-mode-map "\C-c\C-s"   'ess-switch-process) ; use a
 148                                         ; different process for the buffer.
 149   (define-key ess-mode-map "\C-c\C-t"   'ess-execute-in-tb)
 150   (define-key ess-mode-map "\C-c\t"     'ess-complete-object-name)
 151   (define-key ess-mode-map "\M-\t"      'comint-replace-by-expanded-filename)
 152   (define-key ess-mode-map "\M-?"       'ess-list-object-completions)
 153   ;; wrong here (define-key ess-mode-map "\C-c\C-k" 'ess-request-a-process)
 154   (define-key ess-mode-map "\C-c\C-k"   'ess-force-buffer-current)
 155   (define-key ess-mode-map "\C-c`"      'ess-parse-errors) ; \C-x reserved!
 156   (define-key ess-mode-map "{"          'ess-electric-brace)
 157   (define-key ess-mode-map "}"          'ess-electric-brace)
 158   (define-key ess-mode-map "\e\C-h"     'ess-mark-function)
 159   (define-key ess-mode-map "\e\C-q"     'ess-indent-exp)
 160   (define-key ess-mode-map "\177"       'backward-delete-char-untabify)
 161   (define-key ess-mode-map "\t"         'ess-indent-command)
 162   (define-key ess-mode-map "\C-c\C-q"   'ess-quit)
 163   (define-key ess-mode-map "\C-c\C-e"   ess-eval-map))
 164
 165 (require 'noweb-mode)
 166 (easy-menu-define
 167  ess-mode-menu ess-mode-map
 168  "Menu for use in `ess-mode'."
 169  '("ESS" ; ESS-mode
 170    ["What is this? (beta)"    ess-mouse-me                      t]
 171    ["Load file"  ess-load-file t]
 172    ("Eval and Go"
 173     ["Eval buffer"      ess-eval-buffer-and-go            t]
 174     ["Eval region"      ess-eval-region-and-go            t]
 175     ["Eval function"    ess-eval-function-and-go          t]
 176     ["Eval line"        ess-eval-line-and-go              t]
 177     ["Eval chunk"       ess-eval-chunk-and-go    noweb-mode]
 178     ["Eval thread"      ess-eval-thread-and-go   noweb-mode]
 179     ["About"            (ess-goto-info "Evaluating code") t]
 180     )
 181    ("ESS Eval"
 182     ["Eval buffer"      ess-eval-buffer                   t]
 183     ["Eval region"      ess-eval-region                   t]
 184     ["Eval function"    ess-eval-function                 t]
 185     ["Enter expression" ess-execute-in-tb                 t]
 186     ["Eval line"        ess-eval-line                     t]
 187     ["Eval line & step" ess-eval-line-and-step            t]
 188     ["Eval chunk"       ess-eval-chunk           noweb-mode]
 189     ["Eval thread"      ess-eval-thread          noweb-mode]
 190     ["About"            (ess-goto-info "Evaluating code") t]
 191     )
 192    ("Motion..."
 193     ["Edit new object"          ess-dump-object-into-edit-buffer t]
 194     ["Goto end of ESS buffer"   ess-switch-to-end-of-ESS        t]
 195     ["Switch to ESS buffer"     ess-switch-to-ESS               t]
 196     ["Beginning of function"    ess-beginning-of-function       t]
 197     ["End of function"          ess-end-of-function             t]
 198     )
 199    ("ESS list..."
 200     ["Backward list"            backward-list                   t]
 201     ["Forward list"             forward-list                    t]
 202     ["Next parenthesis"         down-list                       t]
 203     ["Enclosing parenthesis"    backward-up-list                t]
 204     ["Backward sexp"            backward-sexp                   t]
 205     ["Forward sexp"             forward-sexp                    t]
 206     ["About"                    (Info-goto-node "(Emacs)Lists") t]
 207     )
 208    ("ESS Edit"
 209     ["Complete Filename" comint-replace-by-expanded-filename    t]
 210     ["Complete Object"   ess-complete-object-name               t]
 211     ["Kill sexp"         kill-sexp                              t]
 212     ["Mark function"     ess-mark-function                      t]
 213     ["Indent expression" ess-indent-exp                         t]
 214     ["Indent line"       ess-indent-command                     t]
 215     ["Toggle Auto-Fill Mode" auto-fill-mode                     t]
 216     ["Undo"              undo                                   t]
 217     ["About"             (ess-goto-info "Edit buffer")          t]
 218     )
 219    ("Start Process"
 220     ;; SJE - :help not yet recognised in XEmacs.
 221     ["R"     R   t] ;; :help "Start a new R process" :active t
 222     ["S"     S   t] ;; :help "Start a new S process" :active t
 223     ["Sqpe" Sqpe ess-microsoft-p] ;; :help "Start a new Sqpe process" :active t
 224     ["S+6-exisiting" S+6-existing ess-microsoft-p] ;; :help "Access an existing S process" :active t
 225     ["SAS"   SAS-menu t] ;;  :help "Start a new SAS process" :active t
 226     ;; The following menu item "Other" is a place-holder that will
 227     ;; be replaced with the other versions of R and Sqpe that can be run.
 228     ;; See `ess-r-versions-create' and ess-site.el
 229     ("Other"
 230      ["No other R or Sqpe versions" nil nil])
 231     ["About"
 232      (ess-goto-info "Starting up") t]
 233      ;; :help "Read about starting a new ESS process" :active t]
 234     )
 235    ["Switch Process"    ess-switch-process              t]
 236    "------"
 237    ["Describe"          describe-mode                   t]
 238    ["About editing" (ess-goto-info "Editing")   t]
 239    ["Read ESS info" (ess-goto-info "") t]
 240    ["Send bug report"   ess-submit-bug-report           t]
 241    ))
 242
 243 (defun SAS-menu ()
 244   "Start SAS from the menu."
 245   (interactive)
 246   (if ess-microsoft-p
 247       ;; replace with other choices for starting SAS under XEmacs?
 248       (error "SAS cannot be started this way in ESS on Windows.")
 249     (SAS)))
 250
 251 (defun ess-mode-xemacs-menu ()
 252   "Hook to install `ess-mode' menu for XEmacs (w/ easymenu)."
 253   (if 'ess-mode
 254         (easy-menu-add ess-mode-menu)
 255     (easy-menu-remove ess-mode-menu)))
 256
 257 (if (featurep 'xemacs)
 258     (add-hook 'ess-mode-hook 'ess-mode-xemacs-menu))
 259
 260 (defun ess-mode (&optional alist proc-name)
 261   "Major mode for editing ESS source.
 262 Optional arg ALIST describes how to customize the editing mode.
 263 Optional arg PROC-NAME is name of associated inferior process.
 264
 265 \\{ess-mode-map}
 266
 267 Extra binding to note:  'ESC C-\\' indent-region.
 268
 269 Entry to this mode runs the hooks in ess-mode-hook.
 270
 271 You can send text to the inferior ESS process from other buffers containing
 272 ESS source.
 273     `ess-eval-region' sends the current region to the ESS process.
 274     `ess-eval-buffer' sends the current buffer to the ESS process.
 275     `ess-eval-function' sends the current function to the ESS process.
 276     `ess-eval-line' sends the current line to the ESS process.
 277     `ess-beginning-of-function' and `ess-end-of-function' move the point to
 278         the beginning and end of the current ESS function.
 279     `ess-switch-to-ESS' switches the current buffer to the ESS process buffer.
 280     `ess-switch-to-end-of-ESS' switches the current buffer to the ESS process
 281         buffer and puts point at the end of it.
 282
 283     `ess-eval-region-and-go', `ess-eval-buffer-and-go',
 284         `ess-eval-function-and-go', and `ess-eval-line-and-go' switch to the S
 285         process buffer after sending their text.
 286
 287     `ess-load-file' sources a file of commands to the ESS process.
 288
 289 \\[ess-indent-command] indents for ESS code.
 290 \\[backward-delete-char-untabify] converts tabs to spaces as it moves back.
 291 Comments are indented in a similar way to Emacs-lisp mode:
 292        `###'     beginning of line
 293        `##'      the same level of indentation as the code
 294        `#'       the same column on the right, or to the right of such a
 295                  column if that is not possible.(default value 40).
 296                  \\[indent-for-comment] command automatically inserts such a
 297                  `#' in the right place, or aligns such a comment if it is
 298                  already inserted.
 299 \\[ess-indent-exp] command indents each line of the ESS grouping following point.
 300
 301 Variables controlling indentation style:
 302  `ess-tab-always-indent'
 303     Non-nil means TAB in ESS mode should always reindent the current line,
 304     regardless of where in the line point is when the TAB command is used.
 305  `ess-auto-newline'
 306     Non-nil means automatically newline before and after braces inserted in S
 307     code.
 308  `ess-indent-level'
 309     Indentation of ESS statements within surrounding block.
 310     The surrounding block's indentation is the indentation of the line on
 311     which the open-brace appears.
 312  `ess-continued-statement-offset'
 313     Extra indentation given to a substatement, such as the then-clause of an
 314     if or body of a while.
 315  `ess-continued-brace-offset'
 316     Extra indentation given to a brace that starts a substatement.
 317     This is in addition to ess-continued-statement-offset.
 318  `ess-brace-offset'
 319     Extra indentation for line if it starts with an open brace.
 320  `ess-arg-function-offset'
 321     Extra indent for internal substatements of function `foo' that called
 322     in `arg=foo(...)' form.
 323    If not number, the statements are indented at open-parenthesis following
 324    `foo'.
 325  `ess-expression-offset'
 326     Extra indent for internal substatements of `expression' that specified
 327     in `obj <- expression(...)' form.
 328     If not number, the statements are indented at open-parenthesis following
 329     `expression'.
 330  `ess-brace-imaginary-offset'
 331     An open brace following other text is treated as if it were
 332     this far to the right of the start of its line.
 333  `ess-else-offset'
 334     Extra indentation for line if it starts with `else'.
 335  `ess-close-brace-offset'
 336     Extra indentation for closing braces.
 337  `ess-fancy-comments'
 338     Non-nil means distinguish between #, ##, and ### for indentation.
 339
 340 Furthermore, \\[ess-set-style] command enables you to set up predefined ess-mode
 341 indentation style. At present, predefined style are `BSD', `GNU', `K&R', `C++',
 342 `CLB' (quoted from C language style)."
 343   (interactive)
 344   (kill-all-local-variables) ;; NOTICE THIS!
 345   (ess-setq-vars-local alist)
 346   (ess-write-to-dribble-buffer
 347    (format "(ess-mode-1): ess-language=%s, ess-dialect=%s buf=%s \n"
 348            ess-language
 349            ess-dialect
 350            (current-buffer)))
 351   ;; (ess-write-to-dribble-buffer
 352   ;;  (format "(ess-mode-1.2): ess-process= %s \n"
 353   ;;   (ess-local-process-name ess-local-process-name "none")))
 354   (ess-write-to-dribble-buffer
 355    (format "(ess-mode-1.5): alist=%s \n"
 356            alist))
 357   (setq major-mode 'ess-mode)
 358   (setq mode-name (concat "ESS[" ess-language "]")) ; was ess-dialect
 359   ;; The following line does the next 20 or so :-).
 360   (ess-write-to-dribble-buffer
 361    (format "(ess-mode-1.6): editing-alist=%s \n"
 362            ess-mode-editing-alist))
 363   (ess-setq-vars-local ess-mode-editing-alist)
 364
 365   (use-local-map ess-mode-map)
 366   (set-syntax-table ess-mode-syntax-table)
 367
 368   ;; Keep <tabs> out of the code.
 369   (make-local-variable 'indent-tabs-mode)
 370   (setq indent-tabs-mode nil)
 371
 372   ;;  (make-local-variable 'paragraph-start)
 373   ;;  (setq paragraph-start (concat "^$\\|" page-delimiter))
 374   ;;  (make-local-variable 'paragraph-separate)
 375   ;;  (setq paragraph-separate paragraph-start)
 376   ;;  (make-local-variable 'paragraph-ignore-fill-prefix)
 377   ;;  (setq paragraph-ignore-fill-prefix t)
 378   ;;  (make-local-variable 'indent-line-function)
 379   ;;  (setq indent-line-function 'ess-indent-line)
 380   ;;  (make-local-variable 'require-final-newline)
 381   ;;  (setq require-final-newline t)
 382   ;;  (make-local-variable 'comment-start)
 383   ;;  (setq comment-start "#")
 384   ;;  (make-local-variable 'comment-start-skip)
 385   ;;  (setq comment-start-skip "#+ *")
 386   ;;  (make-local-variable 'comment-column)
 387   ;;  (setq comment-column 40)
 388   ;;  (make-local-variable 'comment-indent-function)
 389   ;;  (setq comment-indent-function 'ess-comment-indent)
 390   ;;  (make-local-variable 'parse-sexp-ignore-comments)
 391   ;;  (setq parse-sexp-ignore-comments t)
 392   ;;  (ess-set-style ess-default-style)
 393   ;;  (make-local-variable 'ess-local-process-name)
 394   ;;  (make-local-variable 'ess-keep-dump-files)
 395   (put 'ess-local-process-name 'permanent-local t) ; protect from RCS
 396   (setq mode-line-process ;; AJR: in future, XEmacs will use modeline-process.
 397         '(" [" (ess-local-process-name ess-local-process-name "none") "]"))
 398   ;; SJE Tue 28 Dec 2004: do not attempt to load object name db.
 399   ;; (ess-load-object-name-db-file)
 400   (run-hooks 'ess-mode-hook)
 401   (ess-write-to-dribble-buffer "\nFinished setting up ESS-mode.\n"))
 402
 403 ;;*;; User commands in ess-mode
 404
 405 ;;;*;;; Handy commands
 406
 407 (defun ess-execute-in-tb ()
 408   "Like `ess-execute', but always evaluates in temp buffer."
 409   (interactive)
 410   (let ((ess-execute-in-process-buffer nil))
 411     (call-interactively 'ess-execute)))
 412
 413 ;;;*;;; Buffer motion/manipulation commands
 414
 415 (defun ess-beginning-of-function ()
 416   "Leave (and return) the point at the beginning of the current ESS function."
 417   (interactive)
 418   (let ((init-point (point))
 419         beg end done)
 420     ;;DBG (ess-write-to-dribble-buffer "ess-BEG-of-fun:")
 421     ;; in case we're sitting in a function header:
 422     (if (search-forward "(" (ess-line-end-position 2) t); at most end of next line
 423         (forward-char 1))
 424     (while (not done)
 425       (if (re-search-backward ess-function-pattern (point-min) t)
 426           nil
 427         (goto-char init-point)
 428         (error "Point is not in a function."))
 429
 430       (setq beg (point))
 431       ;;DBG (ess-write-to-dribble-buffer
 432       ;;DBG (format "Match,Pt:(%d,%d),%d" (match-beginning 0)(match-end 0) beg))
 433       (forward-list 1)                  ; get over arguments
 434       ;;DBG (ess-write-to-dribble-buffer ":")
 435       ;; The following used to bomb  "Unbalanced parentheses", n1, n2
 436       ;; when the above (search-forward "(" ..) wasn't delimited :
 437       (forward-sexp 1)                  ; move over braces
 438       ;;DBG (ess-write-to-dribble-buffer "|")
 439       (setq end (point))
 440       (goto-char beg)
 441       ;; current function must begin and end around point
 442       (setq done (and (>= end init-point) (<= beg init-point))))
 443     ;;DBG (ess-write-to-dribble-buffer (format "found beg=%d\n" beg))
 444     beg))
 445
 446 (defun ess-end-of-function (&optional beginning)
 447   "Leave the point at the end of the current ESS function.
 448 Optional argument for location of beginning.  Return '(beg end)."
 449   (interactive)
 450   (if beginning
 451       (goto-char beginning)
 452     (setq beginning (ess-beginning-of-function)))
 453   (forward-list 1)                      ; get over arguments
 454   (forward-sexp 1)                      ; move over braces
 455   ;;DBG (ess-write-to-dribble-buffer "ess-END-of-fun: found ok\n")
 456   (list beginning (point))
 457   )
 458
 459 ;;; Kurt's version, suggested 970306.
 460 (defun ess-mark-function ()
 461   "Put mark at end of ESS function, point at beginning."
 462   (interactive)
 463   (let ((beg (ess-beginning-of-function)))
 464     (push-mark (point))
 465     (ess-end-of-function beg)
 466     (exchange-point-and-mark)))
 467
 468 ;; Donated by Stephen Eglen, 2001-08-29:
 469 ;; This command is analogous to `narrow-to-defun' (elisp)
 470 ;; and `py-narrow-to-defun' (python)."
 471 (defun ess-narrow-to-defun ()
 472   "Make text outside current function invisible.
 473 If text is already narrowed, this is removed before narrowing to the
 474 current function."
 475   (interactive)
 476    ;; if point is not in a function, ess-end-of-function catches the error.
 477   (save-excursion
 478     (widen)
 479     (let* ((beg-end (ess-end-of-function)))
 480       (narrow-to-region (nth 0 beg-end) (nth 1 beg-end)))))
 481
 482 ;;*;; Loading files
 483
 484 (defun ess-check-modifications nil
 485   "Check whether loading this file would overwrite some ESS objects
 486 which have been modified more recently than this file, and confirm
 487 if this is the case."
 488   ;; FIXME: this should really cycle through all top-level assignments in
 489   ;; the buffer
 490   (and (buffer-file-name) ess-filenames-map
 491        (let ((sourcemod (nth 5 (file-attributes (buffer-file-name))))
 492              (objname))
 493          (save-excursion
 494            (goto-char (point-min))
 495            ;; Get name of assigned object, if we can find it
 496            (setq objname
 497                  (and
 498                   (re-search-forward
 499                    "^\\s *\"?\\(\\(\\sw\\|\\s_\\)+\\)\"?\\s *[<_]"
 500                    nil
 501                    t)
 502                   (buffer-substring (match-beginning 1)
 503                                     (match-end 1)))))
 504          (and
 505           sourcemod                     ; the file may have been deleted
 506           objname                       ; may not have been able to
 507                                         ; find name
 508           (ess-modtime-gt (ess-object-modtime objname) sourcemod)
 509           (not (y-or-n-p
 510
 511                 (format
 512                  "The ESS object %s is newer than this file. Continue?"
 513                  objname)))
 514           (error "Aborted")))))
 515
 516 (defun ess-check-source (fname)
 517   "If file FNAME has an unsaved buffer, offer to save it.
 518 Returns t if the buffer existed and was modified, but was not saved."
 519   (let ((buff (get-file-buffer fname)))
 520     ;; RMH: Corrections noted below are needed for C-c C-l to work
 521     ;; correctly when issued from *S* buffer.
 522     ;; The following barfs since
 523     ;; 1. `if' does not accept a buffer argument, `not' does.
 524     ;; 2. (buffer-file-name) is not necessarily defined for *S*
 525     ;;(if buff
 526     ;; (let ((deleted (not (file-exists-p (buffer-file-name)))))
 527     ;; Next 2 lines are RMH's solution:
 528     (if (not(not buff))
 529         (let ((deleted (not (file-exists-p fname))))
 530           (if (and deleted (not (buffer-modified-p buff)))
 531               ;; Buffer has been silently deleted, so silently save
 532               (save-excursion
 533                 (set-buffer buff)
 534                 (set-buffer-modified-p t)
 535                 (save-buffer))
 536             (if (and (buffer-modified-p buff)
 537                      (or ess-mode-silently-save
 538                          (y-or-n-p
 539                           (format "Save buffer %s first? "
 540                                   (buffer-name buff)))))
 541                 (save-excursion
 542                   (set-buffer buff)
 543                   (save-buffer))))
 544           (buffer-modified-p buff)))))
 545
 546 (defun ess-parse-errors (showerr)
 547   "Jump to error in last loaded ESS source file.
 548 With prefix argument, only shows the errors ESS reported."
 549   (interactive "P")
 550   (ess-make-buffer-current)
 551   (let ((errbuff (get-buffer ess-error-buffer-name)))
 552     (if (not errbuff)
 553         (error "You need to do a load first!")
 554       (set-buffer errbuff)
 555       (goto-char (point-max))
 556       (if
 557           (re-search-backward
 558            "^\\(Syntax error: .*\\) at line \\([0-9]*\\), file \\(.*\\)$"
 559            nil
 560            t)
 561           (let* ((filename (buffer-substring (match-beginning 3) (match-end 3)))
 562                  (fbuffer (get-file-buffer filename))
 563                  (linenum (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))
 564                  (errmess (buffer-substring (match-beginning 1) (match-end 1))))
 565             (if showerr
 566                   (ess-display-temp-buffer errbuff)
 567               (if fbuffer nil
 568                 (setq fbuffer (find-file-noselect filename))
 569                 (save-excursion
 570                   (set-buffer fbuffer)
 571                   (ess-mode)))
 572               (pop-to-buffer fbuffer)
 573               (goto-line linenum))
 574             (princ errmess t))
 575         (message "Not a syntax error.")
 576         (ess-display-temp-buffer errbuff)))))
 577
 578 ;;*;; ESS code formatting/indentation
 579
 580 ;;;*;;; User commands
 581
 582 (defun ess-electric-brace (arg)
 583   "Insert character and correct line's indentation."
 584   (interactive "P")
 585   (let (insertpos)
 586     (if (and (not arg)
 587              (eolp)
 588              (or (save-excursion
 589                    (skip-chars-backward " \t")
 590                    (bolp))
 591                  (if ess-auto-newline (progn (ess-indent-line) (newline) t) nil)))
 592         (progn
 593           (insert last-command-char)
 594           (ess-indent-line)
 595           (if ess-auto-newline
 596               (progn
 597                 (newline)
 598                 ;; (newline) may have done auto-fill
 599                 (setq insertpos (- (point) 2))
 600                 (ess-indent-line)))
 601           (save-excursion
 602             (if insertpos (goto-char (1+ insertpos)))
 603             (delete-char -1))))
 604     (if insertpos
 605         (save-excursion
 606           (goto-char insertpos)
 607           (self-insert-command (prefix-numeric-value arg)))
 608       (self-insert-command (prefix-numeric-value arg)))))
 609
 610 (defun ess-indent-command (&optional whole-exp)
 611   "Indent current line as ESS code, or in some cases insert a tab character.
 612 If `ess-tab-always-indent' is non-nil (the default), always indent
 613 current line.  Otherwise, indent the current line only if point is at
 614 the left margin or in the line's indentation; otherwise insert a tab.
 615 A numeric argument, regardless of its value, means indent rigidly all
 616 the lines of the expression starting after point so that this line
 617 becomes properly indented.  The relative indentation among the lines
 618 of the expression are preserved."
 619   (interactive "P")
 620   (if whole-exp
 621       ;; If arg, always indent this line as S
 622       ;; and shift remaining lines of expression the same amount.
 623       (let ((shift-amt (ess-indent-line))
 624             beg end)
 625         (save-excursion
 626           (if ess-tab-always-indent
 627               (beginning-of-line))
 628           (setq beg (point))
 629           (backward-up-list 1)
 630           (forward-list 1)
 631           (setq end (point))
 632           (goto-char beg)
 633           (forward-line 1)
 634           (setq beg (point)))
 635         (if (> end beg)
 636             (indent-code-rigidly beg end shift-amt)))
 637     (if (and (not ess-tab-always-indent)
 638              (save-excursion
 639                (skip-chars-backward " \t")
 640                (not (bolp))))
 641         (insert-tab)
 642       (ess-indent-line))))
 643
 644 (defun ess-indent-exp ()
 645   "Indent each line of the ESS grouping following point."
 646   (interactive)
 647   (let ((indent-stack (list nil))
 648         (contain-stack (list (point)))
 649         (case-fold-search nil)
 650         ;; restart
 651         outer-loop-done innerloop-done state ostate
 652         this-indent
 653         last-sexp
 654         last-depth
 655         at-else at-brace
 656         (opoint (point))
 657         (next-depth 0))
 658     (save-excursion
 659       (forward-sexp 1))
 660     (save-excursion
 661       (setq outer-loop-done nil)
 662       (while (and (not (eobp)) (not outer-loop-done))
 663         (setq last-depth next-depth)
 664         ;; Compute how depth changes over this line
 665         ;; plus enough other lines to get to one that
 666         ;; does not end inside a comment or string.
 667         ;; Meanwhile, do appropriate indentation on comment lines.
 668         (setq innerloop-done nil)
 669         (while (and (not innerloop-done)
 670                     (not (and (eobp) (setq outer-loop-done t))))
 671           (setq ostate state)
 672           (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
 673                                           nil nil state))
 674           (setq next-depth (car state))
 675           (if (and (car (cdr (cdr state)))
 676                    (>= (car (cdr (cdr state))) 0))
 677               (setq last-sexp (car (cdr (cdr state)))))
 678           (if (or (nth 4 ostate))
 679               (ess-indent-line))
 680           (if (nth 4 state)
 681               (and (ess-indent-line)
 682                    (setcar (nthcdr 4 state) nil)))
 683           (if (or (nth 3 state))
 684               (forward-line 1)
 685             (setq innerloop-done t)))
 686         (if (<= next-depth 0)
 687             (setq outer-loop-done t))
 688         (if outer-loop-done
 689             nil
 690           ;; If this line had ..))) (((.. in it, pop out of the levels
 691           ;; that ended anywhere in this line, even if the final depth
 692           ;; doesn't indicate that they ended.
 693           (while (> last-depth (nth 6 state))
 694             (setq indent-stack (cdr indent-stack)
 695                   contain-stack (cdr contain-stack)
 696                   last-depth (1- last-depth)))
 697           (if (/= last-depth next-depth)
 698               (setq last-sexp nil))
 699           ;; Add levels for any parens that were started in this line.
 700           (while (< last-depth next-depth)
 701             (setq indent-stack (cons nil indent-stack)
 702                   contain-stack (cons nil contain-stack)
 703                   last-depth (1+ last-depth)))
 704           (if (null (car contain-stack))
 705               (setcar contain-stack (or (car (cdr state))
 706                                         (save-excursion (forward-sexp -1)
 707                                                         (point)))))
 708           (forward-line 1)
 709           (skip-chars-forward " \t")
 710           (if (eolp)
 711               nil
 712             (if (and (car indent-stack)
 713                      (>= (car indent-stack) 0))
 714                 ;; Line is on an existing nesting level.
 715                 ;; Lines inside parens are handled specially.
 716                 (if (/= (char-after (car contain-stack)) ?{)
 717                     (setq this-indent (car indent-stack))
 718                   ;; Line is at statement level.
 719                   ;; Is it a new statement?  Is it an else?
 720                   ;; Find last non-comment character before this line
 721                   (save-excursion
 722                     (setq at-else (looking-at "else\\W"))
 723                     (setq at-brace (= (following-char) ?{))
 724                     (ess-backward-to-noncomment opoint)
 725                     (if (ess-continued-statement-p)
 726                         ;; Preceding line did not end in comma or semi;
 727                         ;; indent this line  ess-continued-statement-offset
 728                         ;; more than previous.
 729                         (progn
 730                           (ess-backward-to-start-of-continued-exp (car contain-stack))
 731                           (setq this-indent
 732                                 (+ ess-continued-statement-offset (current-column)
 733                                    (if at-brace ess-continued-brace-offset 0))))
 734                       ;; Preceding line ended in comma or semi;
 735                       ;; use the standard indent for this level.
 736                       (if at-else
 737                           (progn (ess-backward-to-start-of-if opoint)
 738                                  (setq this-indent (+ ess-else-offset
 739                                                       (current-indentation))))
 740                         (setq this-indent (car indent-stack))))))
 741               ;; Just started a new nesting level.
 742               ;; Compute the standard indent for this level.
 743               (let ((val (ess-calculate-indent
 744                            (if (car indent-stack)
 745                                (- (car indent-stack))))))
 746                 (setcar indent-stack
 747                         (setq this-indent val))))
 748             ;; Adjust line indentation according to its contents
 749             (if (= (following-char) ?})
 750                 ;;(setq this-indent (- this-indent ess-indent-level)))
 751                 (setq this-indent (+ this-indent
 752                                      (- ess-close-brace-offset ess-indent-level))))
 753             (if (= (following-char) ?{)
 754                 (setq this-indent (+ this-indent ess-brace-offset)))
 755             ;; Put chosen indentation into effect.
 756             (or (= (current-column) this-indent)
 757                 (= (following-char) ?\#)
 758                 (progn
 759                   (delete-region (point) (progn (beginning-of-line) (point)))
 760                   (indent-to this-indent)))
 761             ;; Indent any comment following the text.
 762             (or (looking-at comment-start-skip)
 763                 (if (re-search-forward comment-start-skip
 764                                        (save-excursion (end-of-line)
 765                                                        (point)) t)
 766                     (progn (indent-for-comment) (beginning-of-line))))))))))
 767 ;; (message "Indenting ESS expression...done")
 768
 769 ;;;*;;; Support functions for indentation
 770
 771 (defun ess-comment-indent ()
 772   (if (looking-at "###")
 773       (current-column)
 774     (if (looking-at "##")
 775         (let ((tem (ess-calculate-indent)))
 776           (if (listp tem) (car tem) tem))
 777       (skip-chars-backward " \t")
 778       (max (if (bolp) 0 (1+ (current-column)))
 779            comment-column))))
 780
 781 (defun ess-indent-line ()
 782   "Indent current line as ESS code.
 783 Return the amount the indentation changed by."
 784   (let ((indent (ess-calculate-indent nil))
 785         beg shift-amt
 786         (case-fold-search nil)
 787         (pos (- (point-max) (point))))
 788     (beginning-of-line)
 789     (setq beg (point))
 790     (cond ((eq indent nil)
 791            (setq indent (current-indentation)))
 792           (t
 793            (skip-chars-forward " \t")
 794            (if (and ess-fancy-comments (looking-at "###"))
 795                (setq indent 0))
 796            (if (and ess-fancy-comments
 797                     (looking-at "#")
 798                     (not (looking-at "##")))
 799                (setq indent comment-column)
 800              (if (eq indent t) (setq indent 0))
 801              (if (listp indent) (setq indent (car indent)))
 802              (cond ((and (looking-at "else\\b")
 803                          (not (looking-at "else\\s_")))
 804                     (setq indent (save-excursion
 805                                    (ess-backward-to-start-of-if)
 806                                    (+ ess-else-offset (current-indentation)))))
 807                    ((= (following-char) ?})
 808                     (setq indent
 809                           (+ indent
 810                              (- ess-close-brace-offset ess-indent-level))))
 811                    ((= (following-char) ?{)
 812                     (setq indent (+ indent ess-brace-offset)))))))
 813     (skip-chars-forward " \t")
 814     (setq shift-amt (- indent (current-column)))
 815     (if (zerop shift-amt)
 816         (if (> (- (point-max) pos) (point))
 817             (goto-char (- (point-max) pos)))
 818       (delete-region beg (point))
 819       (indent-to indent)
 820       ;; If initial point was within line's indentation,
 821       ;; position after the indentation.
 822       ;; Else stay at same point in text.
 823       (if (> (- (point-max) pos) (point))
 824           (goto-char (- (point-max) pos))))
 825     shift-amt))
 826
 827 (defun ess-calculate-indent (&optional parse-start)
 828   "Return appropriate indentation for current line as ESS code.
 829 In usual case returns an integer: the column to indent to.
 830 Returns nil if line starts inside a string, t if in a comment."
 831   (save-excursion
 832     (beginning-of-line)
 833     (let ((indent-point (point))
 834           (case-fold-search nil)
 835           state
 836           containing-sexp)
 837       (if parse-start
 838           (goto-char parse-start)
 839         (beginning-of-defun))
 840       (while (< (point) indent-point)
 841         (setq parse-start (point))
 842         (setq state (parse-partial-sexp (point) indent-point 0))
 843         (setq containing-sexp (car (cdr state))))
 844       (cond ((or (nth 3 state) (nth 4 state))
 845              ;; return nil or t if should not change this line
 846              (nth 4 state))
 847             ((null containing-sexp)
 848              ;; Line is at top level.  May be data or function definition,
 849              (beginning-of-line)
 850              (if (and (/= (following-char) ?\{)
 851                       (save-excursion
 852                         (ess-backward-to-noncomment (point-min))
 853                         (ess-continued-statement-p)))
 854                  ess-continued-statement-offset
 855                0))   ; Unless it starts a function body
 856             ((/= (char-after containing-sexp) ?{)
 857              ;; line is expression, not statement:
 858              ;; indent to just after the surrounding open.
 859              (goto-char containing-sexp)
 860              (let ((bol (save-excursion (beginning-of-line) (point))))
 861
 862                ;; modified by shiba@isac 7.3.1992
 863                (cond ((and (numberp ess-expression-offset)
 864                    (re-search-backward "[ \t]*expression[ \t]*" bol t))
 865                       ;; This regexp match every "expression".
 866                       ;; modified by shiba
 867                       ;;(forward-sexp -1)
 868                       (beginning-of-line)
 869                       (skip-chars-forward " \t")
 870                       ;; End
 871                       (+ (current-column) ess-expression-offset))
 872                      ((and (numberp ess-arg-function-offset)
 873                            (re-search-backward
 874                             "=[ \t]*\\s\"*\\(\\w\\|\\s_\\)+\\s\"*[ \t]*"
 875                             bol t))
 876                       (forward-sexp -1)
 877                       (+ (current-column) ess-arg-function-offset))
 878                      ;; "expression" is searched before "=".
 879                      ;; End
 880                      (t
 881                       (progn (goto-char (1+ containing-sexp))
 882                              (current-column))))))
 883             (t
 884              ;; Statement level.  Is it a continuation or a new statement?
 885              ;; Find previous non-comment character.
 886              (goto-char indent-point)
 887              (ess-backward-to-noncomment containing-sexp)
 888              ;; Back up over label lines, since they don't
 889              ;; affect whether our line is a continuation.
 890              (while (eq (preceding-char) ?\,)
 891                (ess-backward-to-start-of-continued-exp containing-sexp)
 892                (beginning-of-line)
 893                (ess-backward-to-noncomment containing-sexp))
 894              ;; Now we get the answer.
 895              (if (ess-continued-statement-p)
 896                  ;; This line is continuation of preceding line's statement;
 897                  ;; indent  ess-continued-statement-offset  more than the
 898                  ;; previous line of the statement.
 899                  (progn
 900                    (ess-backward-to-start-of-continued-exp containing-sexp)
 901                    (+ ess-continued-statement-offset (current-column)
 902                       (if (save-excursion (goto-char indent-point)
 903                                           (skip-chars-forward " \t")
 904                                           (eq (following-char) ?{))
 905                           ess-continued-brace-offset 0)))
 906                ;; This line starts a new statement.
 907                ;; Position following last unclosed open.
 908                (goto-char containing-sexp)
 909                ;; Is line first statement after an open-brace?
 910                (or
 911                  ;; If no, find that first statement and indent like it.
 912                  (save-excursion
 913                    (forward-char 1)
 914                    (while (progn (skip-chars-forward " \t\n")
 915                                  (looking-at "#"))
 916                      ;; Skip over comments following openbrace.
 917                      (forward-line 1))
 918                    ;; The first following code counts
 919                    ;; if it is before the line we want to indent.
 920                    (and (< (point) indent-point)
 921                         (current-column)))
 922                  ;; If no previous statement,
 923                  ;; indent it relative to line brace is on.
 924                  ;; For open brace in column zero, don't let statement
 925                  ;; start there too.  If ess-indent-level is zero,
 926                  ;; use ess-brace-offset +
 927                  ;; ess-continued-statement-offset instead.
 928                  ;; For open-braces not the first thing in a line,
 929                  ;; add in ess-brace-imaginary-offset.
 930                  (+ (if (and (bolp) (zerop ess-indent-level))
 931                         (+ ess-brace-offset ess-continued-statement-offset)
 932                       ess-indent-level)
 933                     ;; Move back over whitespace before the openbrace.
 934                     ;; If openbrace is not first nonwhite thing on the line,
 935                     ;; add the ess-brace-imaginary-offset.
 936                     (progn (skip-chars-backward " \t")
 937                            (if (bolp) 0 ess-brace-imaginary-offset))
 938                     ;; If the openbrace is preceded by a parenthesized exp,
 939                     ;; move to the beginning of that;
 940                     ;; possibly a different line
 941                     (progn
 942                       (if (eq (preceding-char) ?\))
 943                           (forward-sexp -1))
 944                       ;; Get initial indentation of the line we are on.
 945                       (current-indentation))))))))))
 946
 947 (defun ess-continued-statement-p ()
 948   (let ((eol (point)))
 949     (save-excursion
 950       (cond ((memq (preceding-char) '(nil ?\, ?\; ?\} ?\{ ?\]))
 951              nil)
 952             ;; ((bolp))
 953             ((= (preceding-char) ?\))
 954              (forward-sexp -2)
 955              (looking-at "if\\b[ \t]*(\\|function\\b[ \t]*(\\|for\\b[ \t]*(\\|while\\b[ \t]*("))
 956             ((progn (forward-sexp -1)
 957                     (and (looking-at "else\\b\\|repeat\\b")
 958                          (not (looking-at "else\\s_\\|repeat\\s_"))))
 959              (skip-chars-backward " \t")
 960              (or (bolp)
 961                  (= (preceding-char) ?\;)))
 962             (t
 963              (progn (goto-char eol)
 964                     (skip-chars-backward " \t")
 965                     (or (and (> (current-column) 1)
 966                              (save-excursion (backward-char 1)
 967                                              (looking-at "[-:+*/_><=]")))
 968                         (and (> (current-column) 3)
 969                              (progn (backward-char 3)
 970                                     (looking-at "%[^ \t]%"))))))))))
 971
 972 (defun ess-backward-to-noncomment (lim)
 973   (let (opoint stop)
 974     (while (not stop)
 975       (skip-chars-backward " \t\n\f" lim)
 976       (setq opoint (point))
 977       (beginning-of-line)
 978       (search-forward "#" opoint 'move)
 979       (skip-chars-backward " \t#")
 980       (setq stop (or (/= (preceding-char) ?\n) (<= (point) lim)))
 981         (if stop (point)
 982           (beginning-of-line)))))
 983
 984 (defun ess-backward-to-start-of-continued-exp (lim)
 985   (if (= (preceding-char) ?\))
 986       (forward-sexp -1))
 987   (beginning-of-line)
 988   (if (<= (point) lim)
 989       (goto-char (1+ lim)))
 990   (skip-chars-forward " \t"))
 991
 992 (defun ess-backward-to-start-of-if (&optional limit)
 993   "Move to the start of the last ``unbalanced'' if."
 994   (or limit (setq limit (save-excursion (beginning-of-defun) (point))))
 995   (let ((if-level 1)
 996         (case-fold-search nil))
 997     (while (not (zerop if-level))
 998       (backward-sexp 1)
 999       (cond ((looking-at "else\\b")
1000              (setq if-level (1+ if-level)))
1001             ((looking-at "if\\b")
1002              (setq if-level (1- if-level)))
1003             ((< (point) limit)
1004              (setq if-level 0)
1005              (goto-char limit))))))
1006
1007 ;;;*;;; Predefined indentation styles
1008
1009 (defun ess-set-style (&optional style quiet)
1010   "Set up the `ess-mode' style variables from the `ess-style' variable
1011 or if STYLE argument is given, use that.  It makes the ESS indentation
1012 style variables buffer local."
1013
1014   (interactive)
1015   (let ((ess-styles (mapcar 'car ess-style-alist)))
1016     (if (interactive-p)
1017         (setq style
1018               (let ((style-string ; get style name with completion
1019                      (completing-read
1020                       (format
1021                        "Set ESS mode indentation style (default %s): "
1022                        ess-default-style)
1023                       (vconcat ess-styles)
1024                       (function (lambda (arg) (memq arg ess-styles))))))
1025                 (if (string-equal "" style-string)
1026                     ess-default-style
1027                   (intern style-string)))))
1028     (setq style (or style ess-style)) ; use ess-style if style is nil
1029     (make-local-variable 'ess-style)
1030     (if (memq style ess-styles)
1031         (setq ess-style style)
1032       (error (concat "Bad ESS style: " style)))
1033     (if (not quiet)
1034         (message "ESS-style: %s" ess-style))
1035     ; finally, set the indentation style variables making each one local
1036     (mapcar (function (lambda (ess-style-pair)
1037                         (make-local-variable (car ess-style-pair))
1038                         (set (car ess-style-pair)
1039                              (cdr ess-style-pair))))
1040             (cdr (assq ess-style ess-style-alist)))
1041     ess-style))
1042
1043 ;;*;; Creating and manipulating dump buffers
1044
1045 ;;;*;;; The user command
1046
1047 (defun ess-dump-object-into-edit-buffer (object)
1048   "Edit an ESS object in its own buffer.
1049
1050 Without a prefix argument, this simply finds the file pointed to by
1051 `ess-source-directory'. If this file does not exist, or if a
1052 prefix argument is given, a dump() command is sent to the ESS process to
1053 generate the source buffer."
1054   (interactive
1055    (progn
1056      (require 'ess-inf)
1057      (ess-force-buffer-current "Process to dump from: ")
1058      (ess-read-object-name "Object to edit: ")))
1059   (let* ((dirname (file-name-as-directory
1060                    (if (stringp ess-source-directory)
1061                        ess-source-directory
1062                      (save-excursion
1063                        (set-buffer
1064                         (process-buffer (get-ess-process
1065                                          ess-local-process-name)))
1066                        (ess-setq-vars-local ess-customize-alist)
1067                        (apply ess-source-directory nil)))))
1068          (filename (concat dirname (format ess-dump-filename-template object)))
1069          (old-buff (get-file-buffer filename)))
1070
1071     ;; If the directory doesn't exist, offer to create it
1072     (if (file-exists-p (directory-file-name dirname)) nil
1073       (if (y-or-n-p     ; Approved
1074            (format "Directory %s does not exist. Create it? " dirname))
1075           (make-directory (directory-file-name dirname))
1076         (error "Directory %s does not exist." dirname)))
1077
1078     ;; Three options:
1079     ;;  (1) Pop to an existing buffer containing the file in question
1080     ;;  (2) Find an existing file
1081     ;;  (3) Create a new file by issuing a dump() command to S
1082     ;; Force option (3) if there is a prefix arg
1083
1084     (if current-prefix-arg
1085         (ess-dump-object object filename)
1086       (if old-buff
1087           (progn
1088             (pop-to-buffer old-buff)
1089             (message "Popped to edit buffer."))
1090         ;; No current buffer containing desired file
1091         (if (file-exists-p filename)
1092             (progn
1093               (ess-find-dump-file-other-window filename)
1094               (message "Read %s" filename))
1095           ;; No buffer and no file
1096           (ess-dump-object object filename))))))
1097
1098 (defun ess-dump-object (object filename)
1099   "Dump the ESS object OBJECT into file FILENAME."
1100   (let ((complete-dump-command (format inferior-ess-dump-command
1101                                        object filename)))
1102     (if (file-writable-p filename) nil
1103       (error "Can't dump %s as %f is not writeable." object filename))
1104
1105     ;; Make sure we start fresh
1106     (if (get-file-buffer filename)
1107         (or (kill-buffer (get-file-buffer filename))
1108             (error "Aborted.")))
1109
1110     (ess-command complete-dump-command)
1111     (message "Dumped in %s" filename)
1112
1113     (ess-find-dump-file-other-window filename)
1114
1115     ;; PD, 1Apr97
1116     ;;This ensures that the object gets indented according to ess-mode,
1117     ;;not as the R/S deparser does it. At the same time, it gets rid
1118     ;;of the mess generated by sending TAB characters to the readline
1119     ;;functions in R when you eval-buffer-*.
1120     (indent-region (point-min-marker) (point-max-marker) nil)
1121     (set-buffer-modified-p nil); no need to safe just because of indenting
1122
1123     ;; Don't make backups for temporary files; it only causes clutter.
1124     ;; The ESS object itself is a kind of backup, anyway.
1125     (unless ess-keep-dump-files
1126       (make-local-variable 'make-backup-files)
1127       (setq make-backup-files nil))
1128
1129     ;; Don't get confirmation to delete dumped files when loading
1130     (if (eq ess-keep-dump-files 'check)
1131         (setq ess-keep-dump-files nil))
1132
1133     ;; Delete the file if necessary
1134     (if ess-delete-dump-files
1135         (delete-file (buffer-file-name)))))
1136
1137 (defun ess-find-dump-file-other-window (filename)
1138   "Find ESS source file FILENAME in another window."
1139
1140   (if (file-exists-p filename) nil
1141     (ess-write-to-dribble-buffer
1142      (format "%s does not exist. Bad dump, starting fresh." filename)))
1143
1144   ;; Generate a buffer with the dumped data
1145   (find-file-other-window filename)
1146   (ess-mode ess-customize-alist)
1147
1148   (auto-save-mode 1)            ; Auto save in this buffer
1149   (setq ess-local-process-name ess-current-process-name)
1150
1151   (if ess-function-template
1152       (progn
1153         (goto-char (point-max))
1154         (if (re-search-backward ess-dumped-missing-re nil t)
1155             (progn
1156               (replace-match ess-function-template t t)
1157               (set-buffer-modified-p nil) ; Don't offer to save if killed now
1158               (goto-char (point-min))
1159               (condition-case nil
1160                   ;; This may fail if there are no opens
1161                   (down-list 1)
1162                 (error nil)))))))
1163
1164 ;; AJR: XEmacs, makes sense to dump into "other frame".
1165 (defun ess-dump-object-into-edit-buffer-other-frame (object)
1166   "Edit an ESS object in its own frame."
1167   (switch-to-buffer-other-frame (ess-dump-object-into-edit-buffer object)))
1168
1169 (provide 'ess-mode)
1170
1171 \f ; Local variables section
1172
1173 ;;; This file is automatically placed in Outline minor mode.
1174 ;;; The file is structured as follows:
1175 ;;; Chapters:     ^L ;
1176 ;;; Sections:    ;;*;;
1177 ;;; Subsections: ;;;*;;;
1178 ;;; Components:  defuns, defvars, defconsts
1179 ;;;              Random code beginning with a ;;;;* comment
1180
1181 ;;; Local variables:
1182 ;;; mode: emacs-lisp
1183 ;;; outline-minor-mode: nil
1184 ;;; mode: outline-minor
1185 ;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
1186 ;;; End:
1187
1188 ;;; ess-mode.el ends here
1189