Commits

Anonymous committed 9f8c038

Created

Comments (0)

Files changed (6)

+1998-01-12  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Update to newer package interface.
+
+1998-01-09  SL Baur  <steve@altair.xemacs.org>
+
+	* Repackaged.
+
+1998-01-08  Karl M. Hegbloom  <karlheg@bittersweet.inetarena.com>
+
+	* ChangeLog: Initial packaging for XEmacs 20.5
+# Makefile for Scheme modes lisp code
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+VERSION = 1.01
+PACKAGE = scheme
+PKG_TYPE = regular
+REQUIRES = xemacs-base
+CATEGORY = prog
+
+ELCS = scheme.elc xscheme.elc cmuscheme.elc
+
+include ../../XEmacs.rules
+
+all:: $(ELCS) auto-autoloads.elc custom-load.elc
+
+srckit: srckit-std
+
+binkit: binkit-sourceonly
+;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el.
+
+;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
+
+;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
+;; Maintainer: FSF
+;; Keywords: processes, lisp
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: FSF 19.34.
+
+;;; Commentary:
+
+;;    This is a customisation of comint-mode (see comint.el)
+;;
+;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
+;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al..
+;; 8/88
+;;
+;; Please send me bug reports, bug fixes, and extensions, so that I can
+;; merge them into the master source.
+;;
+;; The changelog is at the end of this file.
+;;
+;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user
+;; interface that communicates process state back to the superior emacs by
+;; outputting special control sequences. The gnumacs package, xscheme.el, has
+;; lots and lots of special purpose code to read these control sequences, and
+;; so is very tightly integrated with the cscheme process. The cscheme
+;; interrupt handler and debugger read single character commands in cbreak
+;; mode; when this happens, xscheme.el switches to special keymaps that bind
+;; the single letter command keys to emacs functions that directly send the
+;; character to the scheme process.  Cmuscheme mode does *not* provide this
+;; functionality. If you are a cscheme user, you may prefer to use the
+;; xscheme.el/cscheme -emacs interaction.
+;; 
+;; Here's a summary of the pros and cons, as I see them.
+;; xscheme: Tightly integrated with inferior cscheme process!  A few commands
+;;	     not in cmuscheme. But. Integration is a bit of a hack.  Input
+;;	     history only keeps the immediately prior input. Bizarre
+;;	     keybindings.
+;; 
+;; cmuscheme: Not tightly integrated with inferior cscheme process.  But.
+;;            Carefully integrated functionality with the entire suite of
+;;            comint-derived CMU process modes. Keybindings reminiscent of
+;;            Zwei and Hemlock. Good input history. A few commands not in
+;;            xscheme.
+;;  
+;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
+;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
+;; Cscheme-specific; you must use cmuscheme.el.  Interested parties are
+;; invited to port xscheme functionality on top of comint mode...
+
+;;; Code:
+
+(require 'scheme)
+(require 'comint)
+
+;;; INFERIOR SCHEME MODE STUFF
+;;;============================================================================
+
+(defvar inferior-scheme-mode-hook nil
+  "*Hook for customising inferior-scheme mode.")
+(defvar inferior-scheme-mode-map nil)
+
+(cond ((not inferior-scheme-mode-map)
+       (setq inferior-scheme-mode-map
+	     (copy-keymap comint-mode-map))
+       (define-key inferior-scheme-mode-map "\M-\C-x" ;gnu convention
+	           'scheme-send-definition)
+       (define-key inferior-scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp)
+       (define-key inferior-scheme-mode-map "\C-c\C-l" 'scheme-load-file)
+       (define-key inferior-scheme-mode-map "\C-c\C-k" 'scheme-compile-file)
+       (scheme-mode-commands inferior-scheme-mode-map))) 
+
+;; Install the process communication commands in the scheme-mode keymap.
+(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention
+(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention
+(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition)
+(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go)
+(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region)
+(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)
+(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)
+(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)
+(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)
+(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)
+(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"
+
+(defvar scheme-buffer)
+
+(defun inferior-scheme-mode ()
+  "Major mode for interacting with an inferior Scheme process.
+
+The following commands are available:
+\\{inferior-scheme-mode-map}
+
+A Scheme process can be fired up with M-x run-scheme.
+
+Customisation: Entry to this mode runs the hooks on comint-mode-hook and
+inferior-scheme-mode-hook (in that order).
+
+You can send text to the inferior Scheme process from other buffers containing
+Scheme source.  
+    switch-to-scheme switches the current buffer to the Scheme process buffer.
+    scheme-send-definition sends the current definition to the Scheme process.
+    scheme-compile-definition compiles the current definition.
+    scheme-send-region sends the current region to the Scheme process.
+    scheme-compile-region compiles the current region.
+
+    scheme-send-definition-and-go, scheme-compile-definition-and-go,
+        scheme-send-region-and-go, and scheme-compile-region-and-go
+        switch to the Scheme process buffer after sending their text.
+For information on running multiple processes in multiple buffers, see
+documentation for variable scheme-buffer.
+
+Commands:
+Return after the end of the process' output sends the text from the 
+    end of process to point.
+Return before the end of the process' output copies the sexp ending at point
+    to the end of the process' output, and sends it.
+Delete converts tabs to spaces as it moves back.
+Tab indents for Scheme; with argument, shifts rest
+    of expression rigidly with the current line.
+C-M-q does Tab on each line starting within following expression.
+Paragraphs are separated only by blank lines.  Semicolons start comments.
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it."
+  (interactive)
+  (comint-mode)
+  ;; Customise in inferior-scheme-mode-hook
+  (setq comint-prompt-regexp "^[^>\n]*>+ *") ; OK for cscheme, oaklisp, T,...
+  (scheme-mode-variables)
+  (setq major-mode 'inferior-scheme-mode)
+  (setq mode-name "Inferior Scheme")
+  (setq mode-line-process '(":%s"))
+  (use-local-map inferior-scheme-mode-map)
+  (setq comint-input-filter (function scheme-input-filter))
+  (setq comint-get-old-input (function scheme-get-old-input))
+  (run-hooks 'inferior-scheme-mode-hook))
+
+(defvar inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
+  "*Input matching this regexp are not saved on the history list.
+Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters.")
+
+(defun scheme-input-filter (str)
+  "Don't save anything matching inferior-scheme-filter-regexp"
+  (not (string-match inferior-scheme-filter-regexp str)))
+
+(defun scheme-get-old-input ()
+  "Snarf the sexp ending at point"
+  (save-excursion
+    (let ((end (point)))
+      (backward-sexp)
+      (buffer-substring (point) end))))
+
+(defun scheme-args-to-list (string)
+  (let ((where (string-match "[ \t]" string)))
+    (cond ((null where) (list string))
+	  ((not (= where 0))
+	   (cons (substring string 0 where)
+		 (scheme-args-to-list (substring string (+ 1 where)
+						 (length string)))))
+	  (t (let ((pos (string-match "[^ \t]" string)))
+	       (if (null pos)
+		   nil
+		 (scheme-args-to-list (substring string pos
+						 (length string)))))))))
+
+(defvar scheme-program-name "scheme"
+  "*Program invoked by the run-scheme command")
+
+(defun run-scheme (cmd)
+  "Run an inferior Scheme process, input and output via buffer *scheme*.
+If there is a process already running in `*scheme*', switch to that buffer.
+With argument, allows you to edit the command line (default is value
+of `scheme-program-name').  Runs the hooks `inferior-scheme-mode-hook'
+\(after the `comint-mode-hook' is run).
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+
+  (interactive (list (if current-prefix-arg
+			 (read-string "Run Scheme: " scheme-program-name)
+			 scheme-program-name)))
+  (if (not (comint-check-proc "*scheme*"))
+      (let ((cmdlist (scheme-args-to-list cmd)))
+	(set-buffer (apply 'make-comint "scheme" (car cmdlist)
+			   nil (cdr cmdlist)))
+	(inferior-scheme-mode)))
+  (setq scheme-program-name cmd)
+  (setq scheme-buffer "*scheme*")
+  (pop-to-buffer "*scheme*"))
+;;;;;###autoload (add-hook 'same-window-buffer-names "*scheme*")
+
+(defun scheme-send-region (start end)
+  "Send the current region to the inferior Scheme process."
+  (interactive "r")
+  (comint-send-region (scheme-proc) start end)
+  (comint-send-string (scheme-proc) "\n"))
+
+(defun scheme-send-definition ()
+  "Send the current definition to the inferior Scheme process."
+  (interactive)
+  (save-excursion
+   (end-of-defun)
+   (let ((end (point)))
+     (beginning-of-defun)
+     (scheme-send-region (point) end))))
+
+(defun scheme-send-last-sexp ()
+  "Send the previous sexp to the inferior Scheme process."
+  (interactive)
+  (scheme-send-region (save-excursion (backward-sexp) (point)) (point)))
+
+(defvar scheme-compile-exp-command "(compile '%s)"
+  "*Template for issuing commands to compile arbitrary Scheme expressions.")
+
+(defun scheme-compile-region (start end)
+  "Compile the current region in the inferior Scheme process.
+\(A BEGIN is wrapped around the region: (BEGIN <region>))"
+  (interactive "r")
+  (comint-send-string (scheme-proc) (format scheme-compile-exp-command
+					    (format "(begin %s)"
+						    (buffer-substring start end))))
+  (comint-send-string (scheme-proc) "\n"))
+
+(defun scheme-compile-definition ()
+  "Compile the current definition in the inferior Scheme process."
+  (interactive)
+  (save-excursion
+   (end-of-defun)
+   (let ((end (point)))
+     (beginning-of-defun)
+     (scheme-compile-region (point) end))))
+
+(defun switch-to-scheme (eob-p)
+  "Switch to the scheme process buffer.
+With argument, positions cursor at end of buffer."
+  (interactive "P")
+  (if (get-buffer scheme-buffer)
+      (pop-to-buffer scheme-buffer)
+      (error "No current process buffer. See variable scheme-buffer."))
+  (cond (eob-p
+	 (push-mark)
+	 (goto-char (point-max)))))
+
+(defun scheme-send-region-and-go (start end)
+  "Send the current region to the inferior Scheme process.
+Then switch to the process buffer."
+  (interactive "r")
+  (scheme-send-region start end)
+  (switch-to-scheme t))
+
+(defun scheme-send-definition-and-go ()
+  "Send the current definition to the inferior Scheme. 
+Then switch to the process buffer."
+  (interactive)
+  (scheme-send-definition)
+  (switch-to-scheme t))
+
+(defun scheme-compile-definition-and-go ()
+  "Compile the current definition in the inferior Scheme. 
+Then switch to the process buffer."
+  (interactive)
+  (scheme-compile-definition)
+  (switch-to-scheme t))
+
+(defun scheme-compile-region-and-go (start end)
+  "Compile the current region in the inferior Scheme. 
+Then switch to the process buffer."
+  (interactive "r")
+  (scheme-compile-region start end)
+  (switch-to-scheme t))
+
+(defvar scheme-source-modes '(scheme-mode)
+  "*Used to determine if a buffer contains Scheme source code.
+If it's loaded into a buffer that is in one of these major modes, it's
+considered a scheme source file by scheme-load-file and scheme-compile-file.
+Used by these commands to determine defaults.")
+
+(defvar scheme-prev-l/c-dir/file nil
+  "Caches the last (directory . file) pair.
+Caches the last pair used in the last scheme-load-file or
+scheme-compile-file command. Used for determining the default in the 
+next one.")
+
+(defun scheme-load-file (file-name)
+  "Load a Scheme file into the inferior Scheme process."
+  (interactive (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file
+				  scheme-source-modes t)) ; T because LOAD 
+                                                          ; needs an exact name
+  (comint-check-source file-name) ; Check to see if buffer needs saved.
+  (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
+				       (file-name-nondirectory file-name)))
+  (comint-send-string (scheme-proc) (concat "(load \""
+					    file-name
+					    "\"\)\n")))
+
+(defun scheme-compile-file (file-name)
+  "Compile a Scheme file in the inferior Scheme process."
+  (interactive (comint-get-source "Compile Scheme file: "
+				  scheme-prev-l/c-dir/file
+				  scheme-source-modes
+				  nil)) ; NIL because COMPILE doesn't
+                                        ; need an exact name.
+  (comint-check-source file-name) ; Check to see if buffer needs saved.
+  (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
+				       (file-name-nondirectory file-name)))
+  (comint-send-string (scheme-proc) (concat "(compile-file \""
+					    file-name
+					    "\"\)\n")))
+
+
+(defvar scheme-buffer nil "*The current scheme process buffer.
+
+MULTIPLE PROCESS SUPPORT
+===========================================================================
+Cmuscheme.el supports, in a fairly simple fashion, running multiple Scheme
+processes. To run multiple Scheme processes, you start the first up with
+\\[run-scheme]. It will be in a buffer named *scheme*. Rename this buffer
+with \\[rename-buffer]. You may now start up a new process with another
+\\[run-scheme]. It will be in a new buffer, named *scheme*. You can
+switch between the different process buffers with \\[switch-to-buffer].
+
+Commands that send text from source buffers to Scheme processes --
+like scheme-send-definition or scheme-compile-region -- have to choose a
+process to send to, when you have more than one Scheme process around. This
+is determined by the global variable scheme-buffer. Suppose you
+have three inferior Schemes running:
+    Buffer	Process
+    foo		scheme
+    bar		scheme<2>
+    *scheme*    scheme<3>
+If you do a \\[scheme-send-definition-and-go] command on some Scheme source
+code, what process do you send it to?
+
+- If you're in a process buffer (foo, bar, or *scheme*), 
+  you send it to that process.
+- If you're in some other buffer (e.g., a source file), you
+  send it to the process attached to buffer scheme-buffer.
+This process selection is performed by function scheme-proc.
+
+Whenever \\[run-scheme] fires up a new process, it resets scheme-buffer
+to be the new process's buffer. If you only run one process, this will
+do the right thing. If you run multiple processes, you can change
+scheme-buffer to another process buffer with \\[set-variable].
+
+More sophisticated approaches are, of course, possible. If you find yourself
+needing to switch back and forth between multiple processes frequently,
+you may wish to consider ilisp.el, a larger, more sophisticated package
+for running inferior Lisp and Scheme processes. The approach taken here is
+for a minimal, simple implementation. Feel free to extend it.")
+
+(defun scheme-proc ()
+  "Returns the current scheme process. See variable scheme-buffer."
+  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-scheme-mode)
+				      (current-buffer)
+				      scheme-buffer))))
+    (or proc
+	(error "No current process. See variable scheme-buffer"))))
+
+
+;;; Do the user's customisation...
+
+(defvar cmuscheme-load-hook nil
+  "This hook is run when cmuscheme is loaded in.
+This is a good place to put keybindings.")
+	
+(run-hooks 'cmuscheme-load-hook)
+
+
+;;; CHANGE LOG
+;;; ===========================================================================
+;;; 8/88 Olin
+;;; Created. 
+;;;
+;;; 2/15/89 Olin
+;;; Removed -emacs flag from process invocation. It's only useful for
+;;; cscheme, and makes cscheme assume it's running under xscheme.el,
+;;; which messes things up royally. A bug.
+;;;
+;;; 5/22/90 Olin
+;;; - Upgraded to use comint-send-string and comint-send-region.
+;;; - run-scheme now offers to let you edit the command line if
+;;;   you invoke it with a prefix-arg. M-x scheme is redundant, and
+;;;   has been removed.
+;;; - Explicit references to process "scheme" have been replaced with
+;;;   (scheme-proc). This allows better handling of multiple process bufs.
+;;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
+;;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist
+;;;   and friends, but interested hackers might find a useful application
+;;;   of this facility.
+;;;
+;;; 3/12/90 Olin
+;;; - scheme-load-file and scheme-compile-file no longer switch-to-scheme.
+;;;   Tale suggested this.
+
+(provide 'cmuscheme)
+
+;;; cmuscheme.el ends here
+(scheme
+  (version VERSION
+   description "Front-end support for Inferior Scheme."
+   filename FILENAME
+   md5sum MD5SUM
+   size SIZE
+   provides (scheme xscheme cmuscheme)
+   requires (REQUIRES)
+   type regular
+))
+;;; scheme.el --- Scheme mode, and its idiosyncratic commands.
+
+;; Copyright (C) 1986, 1987, 1988 Free Software Foundation, Inc.
+
+;; Author: Bill Rozas <jinz@prep.ai.mit.edu>
+;; Keywords: languages, lisp
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: FSF 19.34.
+
+;;; Commentary:
+
+;; Adapted from Lisp mode by Bill Rozas, jinx@prep.
+;; Initially a query replace of Lisp mode, except for the indentation 
+;; of special forms.  Probably the code should be merged at some point 
+;; so that there is sharing between both libraries.
+
+;;; Code:
+
+(defvar scheme-mode-syntax-table nil "")
+(if (not scheme-mode-syntax-table)
+    (let ((i 0))
+      (setq scheme-mode-syntax-table (make-syntax-table))
+      (set-syntax-table scheme-mode-syntax-table)
+
+      ;; Default is atom-constituent.
+      (while (< i 256)
+	(modify-syntax-entry i "_   ")
+	(setq i (1+ i)))
+
+      ;; Word components.
+      (setq i ?0)
+      (while (<= i ?9)
+	(modify-syntax-entry i "w   ")
+	(setq i (1+ i)))
+      (setq i ?A)
+      (while (<= i ?Z)
+	(modify-syntax-entry i "w   ")
+	(setq i (1+ i)))
+      (setq i ?a)
+      (while (<= i ?z)
+	(modify-syntax-entry i "w   ")
+	(setq i (1+ i)))
+
+      ;; Whitespace
+      (modify-syntax-entry ?\t "    ")
+      (modify-syntax-entry ?\n ">   ")
+      (modify-syntax-entry ?\f "    ")
+      (modify-syntax-entry ?\r "    ")
+      (modify-syntax-entry ?  "    ")
+
+      ;; These characters are delimiters but otherwise undefined.
+      ;; Brackets and braces balance for editing convenience.
+      (modify-syntax-entry ?[ "(]  ")
+      (modify-syntax-entry ?] ")[  ")
+      (modify-syntax-entry ?{ "(}  ")
+      (modify-syntax-entry ?} "){  ")
+      (modify-syntax-entry ?\| "  23")
+
+      ;; Other atom delimiters
+      (modify-syntax-entry ?\( "()  ")
+      (modify-syntax-entry ?\) ")(  ")
+      (modify-syntax-entry ?\; "<   ")
+      (modify-syntax-entry ?\" "\"    ")
+      (modify-syntax-entry ?' "  p")
+      (modify-syntax-entry ?` "  p")
+
+      ;; Special characters
+      (modify-syntax-entry ?, "_ p")
+      (modify-syntax-entry ?@ "_ p")
+      (modify-syntax-entry ?# "_ p14")
+      (modify-syntax-entry ?\\ "\\   ")))
+
+(defvar scheme-mode-abbrev-table nil "")
+(define-abbrev-table 'scheme-mode-abbrev-table ())
+
+(defun scheme-mode-variables ()
+  (set-syntax-table scheme-mode-syntax-table)
+  (setq local-abbrev-table scheme-mode-abbrev-table)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "$\\|" page-delimiter))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+  (make-local-variable 'paragraph-ignore-fill-prefix)
+  (setq paragraph-ignore-fill-prefix t)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'scheme-indent-line)
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments t)
+  (make-local-variable 'comment-start)
+  (setq comment-start ";")
+  (make-local-variable 'comment-start-skip)
+  ;; Look within the line for a ; following an even number of backslashes
+  ;; after either a non-backslash or the line beginning.
+  (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
+  (make-local-variable 'comment-column)
+  (setq comment-column 40)
+  (make-local-variable 'comment-indent-function)
+  (setq comment-indent-function 'scheme-comment-indent)
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments t)
+  (setq mode-line-process '("" scheme-mode-line-process)))
+
+(defvar scheme-mode-line-process "")
+
+(defun scheme-mode-commands (map)
+  (define-key map "\t" 'scheme-indent-line)
+  (define-key map "\e\C-q" 'scheme-indent-sexp))
+
+(defvar scheme-mode-map nil)
+(if (not scheme-mode-map)
+    (progn
+      (setq scheme-mode-map (make-sparse-keymap))
+      (scheme-mode-commands scheme-mode-map)))
+
+;;;###autoload
+(defun scheme-mode ()
+  "Major mode for editing Scheme code.
+Editing commands are similar to those of lisp-mode.
+
+In addition, if an inferior Scheme process is running, some additional
+commands will be defined, for evaluating expressions and controlling
+the interpreter, and the state of the process will be displayed in the
+modeline of all Scheme buffers.  The names of commands that interact
+with the Scheme process start with \"xscheme-\".  For more information
+see the documentation for xscheme-interaction-mode.
+
+Commands:
+Delete converts tabs to spaces as it moves back.
+Blank lines separate paragraphs.  Semicolons start comments.
+\\{scheme-mode-map}
+Entry to this mode calls the value of scheme-mode-hook
+if that value is non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (scheme-mode-initialize)
+  (scheme-mode-variables)
+  (run-hooks 'scheme-mode-hook))
+
+(defun scheme-mode-initialize ()
+  (use-local-map scheme-mode-map)
+  (setq major-mode 'scheme-mode)
+  (setq mode-name "Scheme"))
+
+(defvar scheme-mit-dialect t
+  "If non-nil, scheme mode is specialized for MIT Scheme.
+Set this to nil if you normally use another dialect.")
+
+(defun scheme-comment-indent (&optional pos)
+  (save-excursion
+    (if pos (goto-char pos))
+    (cond ((looking-at ";;;") (current-column))
+	  ((looking-at ";;")
+	   (let ((tem (calculate-scheme-indent)))
+	     (if (listp tem) (car tem) tem)))
+	  (t
+	   (skip-chars-backward " \t")
+	   (max (if (bolp) 0 (1+ (current-column)))
+		comment-column)))))
+
+(defvar scheme-indent-offset nil "")
+(defvar scheme-indent-function 'scheme-indent-function "")
+
+(defun scheme-indent-line (&optional whole-exp)
+  "Indent current line as Scheme code.
+With argument, indent any additional lines of the same expression
+rigidly along with this one."
+  (interactive "P")
+  (let ((indent (calculate-scheme-indent)) shift-amt beg end
+	(pos (- (point-max) (point))))
+    (beginning-of-line)
+    (setq beg (point))
+    (skip-chars-forward " \t")
+    (if (looking-at "[ \t]*;;;")
+	;; Don't alter indentation of a ;;; comment line.
+	nil
+      (if (listp indent) (setq indent (car indent)))
+      (setq shift-amt (- indent (current-column)))
+      (if (zerop shift-amt)
+	  nil
+	(delete-region beg (point))
+	(indent-to indent))
+      ;; If initial point was within line's indentation,
+      ;; position after the indentation.  Else stay at same point in text.
+      (if (> (- (point-max) pos) (point))
+	  (goto-char (- (point-max) pos)))
+      ;; If desired, shift remaining lines of expression the same amount.
+      (and whole-exp (not (zerop shift-amt))
+	   (save-excursion
+	     (goto-char beg)
+	     (forward-sexp 1)
+	     (setq end (point))
+	     (goto-char beg)
+	     (forward-line 1)
+	     (setq beg (point))
+	     (> end beg))
+	   (indent-code-rigidly beg end shift-amt)))))
+
+(defun calculate-scheme-indent (&optional parse-start)
+  "Return appropriate indentation for current line as scheme code.
+In usual case returns an integer: the column to indent to.
+Can instead return a list, whose car is the column to indent to.
+This means that following lines at the same level of indentation
+should not necessarily be indented the same way.
+The second element of the list is the buffer position
+of the start of the containing expression."
+  (save-excursion
+    (beginning-of-line)
+    (let ((indent-point (point)) state paren-depth desired-indent (retry t)
+	  last-sexp containing-sexp first-sexp-list-p)
+      (if parse-start
+	  (goto-char parse-start)
+	(beginning-of-defun))
+      ;; Find outermost containing sexp
+      (while (< (point) indent-point)
+	(setq state (parse-partial-sexp (point) indent-point 0)))
+      ;; Find innermost containing sexp
+      (while (and retry (setq paren-depth (car state)) (> paren-depth 0))
+	(setq retry nil)
+	(setq last-sexp (nth 2 state))
+	(setq containing-sexp (car (cdr state)))
+	;; Position following last unclosed open.
+	(goto-char (1+ containing-sexp))
+	;; Is there a complete sexp since then?
+	(if (and last-sexp (> last-sexp (point)))
+	    ;; Yes, but is there a containing sexp after that?
+	    (let ((peek (parse-partial-sexp last-sexp indent-point 0)))
+	      (if (setq retry (car (cdr peek))) (setq state peek))))
+	(if (not retry)
+	    ;; Innermost containing sexp found
+	    (progn
+	      (goto-char (1+ containing-sexp))
+	      (if (not last-sexp)
+		  ;; indent-point immediately follows open paren.
+		  ;; Don't call hook.
+		  (setq desired-indent (current-column))
+		;; Move to first sexp after containing open paren
+		(parse-partial-sexp (point) last-sexp 0 t)
+		(setq first-sexp-list-p (looking-at "\\s("))
+		(cond
+		 ((> (save-excursion (forward-line 1) (point))
+		     last-sexp)
+		  ;; Last sexp is on same line as containing sexp.
+		  ;; It's almost certainly a function call.
+		  (parse-partial-sexp (point) last-sexp 0 t)
+		  (if (/= (point) last-sexp)
+		      ;; Indent beneath first argument or, if only one sexp
+		      ;; on line, indent beneath that.
+		      (progn (forward-sexp 1)
+			     (parse-partial-sexp (point) last-sexp 0 t)))
+		  (backward-prefix-chars))
+		 (t
+		  ;; Indent beneath first sexp on same line as last-sexp.
+		  ;; Again, it's almost certainly a function call.
+		  (goto-char last-sexp)
+		  (beginning-of-line)
+		  (parse-partial-sexp (point) last-sexp 0 t)
+		  (backward-prefix-chars)))))))
+      ;; If looking at a list, don't call hook.
+      (if first-sexp-list-p
+	  (setq desired-indent (current-column)))
+      ;; Point is at the point to indent under unless we are inside a string.
+      ;; Call indentation hook except when overridden by scheme-indent-offset
+      ;; or if the desired indentation has already been computed.
+      (cond ((car (nthcdr 3 state))
+	     ;; Inside a string, don't change indentation.
+	     (goto-char indent-point)
+	     (skip-chars-forward " \t")
+	     (setq desired-indent (current-column)))
+	    ((and (integerp scheme-indent-offset) containing-sexp)
+	     ;; Indent by constant offset
+	     (goto-char containing-sexp)
+	     (setq desired-indent (+ scheme-indent-offset (current-column))))
+	    ((not (or desired-indent
+		      (and (boundp 'scheme-indent-function)
+			   scheme-indent-function
+			   (not retry)
+			   (setq desired-indent
+				 (funcall scheme-indent-function
+					  indent-point state)))))
+	     ;; Use default indentation if not computed yet
+	     (setq desired-indent (current-column))))
+      desired-indent)))
+
+(defun scheme-indent-function (indent-point state)
+  (let ((normal-indent (current-column)))
+    (save-excursion
+      (goto-char (1+ (car (cdr state))))
+      (re-search-forward "\\sw\\|\\s_")
+      (if (/= (point) (car (cdr state)))
+	  (let ((function (buffer-substring (progn (forward-char -1) (point))
+					    (progn (forward-sexp 1) (point))))
+		method)
+	    ;; Who cares about this, really?
+	    ;(if (not (string-match "\\\\\\||" function)))
+	    (setq function (downcase function))
+	    (setq method (get (intern-soft function) 'scheme-indent-function))
+	    (cond ((integerp method)
+		   (scheme-indent-specform method state indent-point))
+		  (method
+		   (funcall method state indent-point))
+		  ((and (> (length function) 3)
+			(string-equal (substring function 0 3) "def"))
+		   (scheme-indent-defform state indent-point))))))))
+
+(defvar scheme-body-indent 2 "")
+
+(defun scheme-indent-specform (count state indent-point)
+  (let ((containing-form-start (car (cdr state))) (i count)
+	body-indent containing-form-column)
+    ;; Move to the start of containing form, calculate indentation
+    ;; to use for non-distinguished forms (> count), and move past the
+    ;; function symbol.  scheme-indent-function guarantees that there is at
+    ;; least one word or symbol character following open paren of containing
+    ;; form.
+    (goto-char containing-form-start)
+    (setq containing-form-column (current-column))
+    (setq body-indent (+ scheme-body-indent containing-form-column))
+    (forward-char 1)
+    (forward-sexp 1)
+    ;; Now find the start of the last form.
+    (parse-partial-sexp (point) indent-point 1 t)
+    (while (and (< (point) indent-point)
+		(condition-case nil
+		    (progn
+		      (setq count (1- count))
+		      (forward-sexp 1)
+		      (parse-partial-sexp (point) indent-point 1 t))
+		  (error nil))))
+    ;; Point is sitting on first character of last (or count) sexp.
+    (cond ((> count 0)
+	   ;; A distinguished form.  Use double scheme-body-indent.
+	   (list (+ containing-form-column (* 2 scheme-body-indent))
+		 containing-form-start))
+	  ;; A non-distinguished form. Use body-indent if there are no
+	  ;; distinguished forms and this is the first undistinguished
+	  ;; form, or if this is the first undistinguished form and
+	  ;; the preceding distinguished form has indentation at least
+	  ;; as great as body-indent.
+	  ((and (= count 0)
+		(or (= i 0)
+		    (<= body-indent normal-indent)))
+	   body-indent)
+	  (t
+	   normal-indent))))
+
+(defun scheme-indent-defform (state indent-point)
+  (goto-char (car (cdr state)))
+  (forward-line 1)
+  (if (> (point) (car (cdr (cdr state))))
+      (progn
+	(goto-char (car (cdr state)))
+	(+ scheme-body-indent (current-column)))))
+
+;;; Let is different in Scheme
+
+(defun would-be-symbol (string)
+  (not (string-equal (substring string 0 1) "(")))
+
+(defun next-sexp-as-string ()
+  ;; Assumes that protected by a save-excursion
+  (forward-sexp 1)
+  (let ((the-end (point)))
+    (backward-sexp 1)
+    (buffer-substring (point) the-end)))
+
+;; This is correct but too slow.
+;; The one below works almost always.
+;;(defun scheme-let-indent (state indent-point)
+;;  (if (would-be-symbol (next-sexp-as-string))
+;;      (scheme-indent-specform 2 state indent-point)
+;;      (scheme-indent-specform 1 state indent-point)))
+
+(defun scheme-let-indent (state indent-point)
+  (skip-chars-forward " \t")
+  (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
+      (scheme-indent-specform 2 state indent-point)
+      (scheme-indent-specform 1 state indent-point)))
+
+;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented
+;; like defun if the first form is placed on the next line, otherwise
+;; it is indented like any other form (i.e. forms line up under first).
+
+(put 'begin 'scheme-indent-function 0)
+(put 'case 'scheme-indent-function 1)
+(put 'delay 'scheme-indent-function 0)
+(put 'do 'scheme-indent-function 2)
+(put 'lambda 'scheme-indent-function 1)
+(put 'let 'scheme-indent-function 'scheme-let-indent)
+(put 'let* 'scheme-indent-function 1)
+(put 'letrec 'scheme-indent-function 1)
+(put 'sequence 'scheme-indent-function 0)
+
+(put 'call-with-input-file 'scheme-indent-function 1)
+(put 'with-input-from-file 'scheme-indent-function 1)
+(put 'with-input-from-port 'scheme-indent-function 1)
+(put 'call-with-output-file 'scheme-indent-function 1)
+(put 'with-output-to-file 'scheme-indent-function 1)
+(put 'with-output-to-port 'scheme-indent-function 1)
+
+;;;; MIT Scheme specific indentation.
+
+(if scheme-mit-dialect
+    (progn
+      (put 'fluid-let 'scheme-indent-function 1)
+      (put 'in-package 'scheme-indent-function 1)
+      (put 'let-syntax 'scheme-indent-function 1)
+      (put 'local-declare 'scheme-indent-function 1)
+      (put 'macro 'scheme-indent-function 1)
+      (put 'make-environment 'scheme-indent-function 0)
+      (put 'named-lambda 'scheme-indent-function 1)
+      (put 'using-syntax 'scheme-indent-function 1)
+
+      (put 'with-input-from-string 'scheme-indent-function 1)
+      (put 'with-output-to-string 'scheme-indent-function 0)
+      (put 'with-values 'scheme-indent-function 1)
+
+      (put 'syntax-table-define 'scheme-indent-function 2)
+      (put 'list-transform-positive 'scheme-indent-function 1)
+      (put 'list-transform-negative 'scheme-indent-function 1)
+      (put 'list-search-positive 'scheme-indent-function 1)
+      (put 'list-search-negative 'scheme-indent-function 1)
+
+      (put 'access-components 'scheme-indent-function 1)
+      (put 'assignment-components 'scheme-indent-function 1)
+      (put 'combination-components 'scheme-indent-function 1)
+      (put 'comment-components 'scheme-indent-function 1)
+      (put 'conditional-components 'scheme-indent-function 1)
+      (put 'disjunction-components 'scheme-indent-function 1)
+      (put 'declaration-components 'scheme-indent-function 1)
+      (put 'definition-components 'scheme-indent-function 1)
+      (put 'delay-components 'scheme-indent-function 1)
+      (put 'in-package-components 'scheme-indent-function 1)
+      (put 'lambda-components 'scheme-indent-function 1)
+      (put 'lambda-components* 'scheme-indent-function 1)
+      (put 'lambda-components** 'scheme-indent-function 1)
+      (put 'open-block-components 'scheme-indent-function 1)
+      (put 'pathname-components 'scheme-indent-function 1)
+      (put 'procedure-components 'scheme-indent-function 1)
+      (put 'sequence-components 'scheme-indent-function 1)
+      (put 'unassigned\?-components 'scheme-indent-function 1)
+      (put 'unbound\?-components 'scheme-indent-function 1)
+      (put 'variable-components 'scheme-indent-function 1)))
+
+(defun scheme-indent-sexp ()
+  "Indent each line of the list starting just after point."
+  (interactive)
+  (let ((indent-stack (list nil)) (next-depth 0) bol
+	outer-loop-done inner-loop-done state this-indent)
+    (save-excursion (forward-sexp 1))
+    (save-excursion
+      (setq outer-loop-done nil)
+      (while (not outer-loop-done)
+	(setq last-depth next-depth
+	      innerloop-done nil)
+	(while (and (not innerloop-done)
+		    (not (setq outer-loop-done (eobp))))
+	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
+					  nil nil state))
+	  (setq next-depth (car state))
+	  (if (car (nthcdr 4 state))
+	      (progn (indent-for-comment)
+		     (end-of-line)
+		     (setcar (nthcdr 4 state) nil)))
+	  (if (car (nthcdr 3 state))
+	      (progn
+		(forward-line 1)
+		(setcar (nthcdr 5 state) nil))
+	    (setq innerloop-done t)))
+	(if (setq outer-loop-done (<= next-depth 0))
+	    nil
+	  (while (> last-depth next-depth)
+	    (setq indent-stack (cdr indent-stack)
+		  last-depth (1- last-depth)))
+	  (while (< last-depth next-depth)
+	    (setq indent-stack (cons nil indent-stack)
+		  last-depth (1+ last-depth)))
+	  (forward-line 1)
+	  (setq bol (point))
+	  (skip-chars-forward " \t")
+	  (if (or (eobp) (looking-at "[;\n]"))
+	      nil
+	    (if (and (car indent-stack)
+		     (>= (car indent-stack) 0))
+		(setq this-indent (car indent-stack))
+	      (let ((val (calculate-scheme-indent
+			  (if (car indent-stack) (- (car indent-stack))))))
+		(if (integerp val)
+		    (setcar indent-stack
+			    (setq this-indent val))
+		  (if (cdr val)
+		      (setcar indent-stack (- (car (cdr val)))))
+		  (setq this-indent (car val)))))
+	    (if (/= (current-column) this-indent)
+		(progn (delete-region bol (point))
+		       (indent-to this-indent)))))))))
+
+(provide 'scheme)
+
+;;; scheme.el ends here
+;;; xscheme.el --- Run MIT-Scheme under XEmacs
+;; Keywords: languages, lisp
+
+;; Copyright (C) 1986,87,89 Free Software Foundation, Inc.
+
+;; Author: Unknown - Probably an MIT Teaching Staff member.
+;; Maintainer: The XEmacs Development Team and its User Base.
+;; Keywords: languages, processes
+;; Version: 1.0-XEmacs
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not synched with FSF.
+
+;;; Commentary:
+
+;;; Requires C-Scheme release 5 or later
+;;; Changes to Control-G handler require runtime version 13.85 or later
+
+;;; You can obtain the Scheme language through:
+;;; <URL:http://www.swiss.ai.mit.edu/scheme-home.html>
+;;; This should work right out of the box, on most properly configured
+;;; Linux systems.  It's the second easiest way to get started
+;;; programming, next to XEmacs Lisp. :-)
+
+;;; Code:
+(require 'scheme)
+
+
+(defgroup scheme nil
+  "Scheme programming."
+  :group 'languages)
+
+(defcustom scheme-program-name "scheme"
+  "*Program invoked by the `run-scheme' command."
+  :type 'string
+  :group 'scheme)
+
+(defcustom scheme-band-name nil
+  "*Band loaded by the `run-scheme' command."
+  :type '(choice (const :tag "None" nil)
+		 (string :tag "File" ""))
+  :group 'scheme)
+
+(defcustom scheme-program-arguments nil
+  "*Arguments passed to the Scheme program by the `run-scheme' command."
+  :type '(choice (const :tag "None" nil)
+		 (string :tag "Args" ""))
+  :group 'scheme)
+
+(defcustom xscheme-allow-pipelined-evaluation t
+  "If non-nil, an expression may be transmitted while another is evaluating.
+Otherwise, attempting to evaluate an expression before the previous expression
+has finished evaluating will signal an error."
+  :type 'boolean
+  :group 'scheme)
+
+(defvar default-xscheme-runlight
+  '(": " xscheme-runlight-string)
+  "Default global (shared) xscheme-runlight modeline format.")
+
+(defvar xscheme-startup-message
+  "This is the Scheme process buffer.
+Type \\[advertised-xscheme-send-previous-expression] to evaluate the expression before point.
+Type \\[xscheme-send-control-g-interrupt] to abort evaluation.
+Type \\[describe-mode] for more information.
+
+"
+  "String to insert into Scheme process buffer first time it is started.
+Is processed with `substitute-command-keys' first.")
+
+(defcustom xscheme-signal-death-message nil
+  "If non-nil, causes a message to be generated when the Scheme process dies."
+  :type 'boolean
+  :group 'scheme)
+
+(defvar xscheme-process-name "*scheme*"
+  "*Process created by the `run-scheme' command.")
+
+(defvar xscheme-buffer-name "*scheme*"
+  "*Buffer created by the `run-scheme' command.")
+
+(defun xscheme-evaluation-commands (keymap)
+  (define-key keymap "\e\C-x" 'xscheme-send-definition)
+  (define-key keymap "\C-x\C-e" 'advertised-xscheme-send-previous-expression)
+  (define-key keymap "\eo" 'xscheme-send-buffer)
+  (define-key keymap "\ez" 'xscheme-send-definition)
+  (define-key keymap "\e\C-m" 'xscheme-send-previous-expression)
+  (define-key keymap "\e\C-z" 'xscheme-send-region))
+
+(defun xscheme-interrupt-commands (keymap)
+  (define-key keymap "\C-c\C-s" 'xscheme-select-process-buffer)
+  (define-key keymap "\C-c\C-b" 'xscheme-send-breakpoint-interrupt)
+  (define-key keymap "\C-c\C-c" 'xscheme-send-control-g-interrupt)
+  (define-key keymap "\C-c\C-u" 'xscheme-send-control-u-interrupt)
+  (define-key keymap "\C-c\C-x" 'xscheme-send-control-x-interrupt))
+
+(xscheme-evaluation-commands scheme-mode-map)
+(xscheme-interrupt-commands scheme-mode-map)
+
+;;;###autoload
+(defun run-scheme (command-line)
+  "Run an inferior Scheme process.
+Output goes to the buffer `*scheme*'.
+With argument, asks for a command line."
+  (interactive
+   (list (read-scheme-command-line current-prefix-arg)))
+  (scheme-start command-line xscheme-process-name xscheme-buffer-name))
+
+(defun reset-scheme ()
+  "Reset the Scheme process."
+  (interactive)
+  (let ((process (get-process xscheme-process-name)))
+    (cond ((or (not process)
+	       (not (eq (process-status process) 'run))
+	       (yes-or-no-p
+"The Scheme process is running, are you SURE you want to reset it? "))
+	   (message "Resetting Scheme process...")
+	   (if process
+	       (progn
+		(kill-process process t)
+		(delete-process process)))
+	   (xscheme-start-process xscheme-process-command-line
+				  xscheme-process-name
+				  xscheme-buffer-name)
+	   (message "Resetting Scheme process...done")))))
+
+(defun scheme-start (command-line process-name buffer-name &optional avoid-set)
+  (if (not avoid-set)
+      (setq-default xscheme-process-command-line command-line))
+  (switch-to-buffer
+   (xscheme-start-process command-line process-name buffer-name))
+  (make-local-variable 'xscheme-process-command-line)
+  (setq xscheme-process-command-line command-line))
+
+(defun read-scheme-command-line (arg)
+  (let ((default
+	  (or xscheme-process-command-line
+	      (xscheme-default-command-line))))
+    (if arg
+	(read-string "Run Scheme: " default)
+      default)))
+
+(defun xscheme-default-command-line ()
+  (concat scheme-program-name " -emacs"
+	  (if scheme-program-arguments
+	      (concat " " scheme-program-arguments)
+	      "")
+	  (if scheme-band-name
+	      (concat " -band " scheme-band-name)
+	      "")))
+
+;;;; Multiple Scheme buffer management commands
+
+(defun start-scheme (buffer-name &optional globally)
+  "Choose a scheme interaction buffer, or create a new one."
+  ;; (interactive "BScheme interaction buffer: \nP")
+  (interactive
+   (list (read-buffer "Scheme interaction buffer: "
+		      xscheme-buffer-name
+		      nil)
+	 current-prefix-arg))
+  (let ((buffer (get-buffer-create buffer-name)))
+    (let ((process (get-buffer-process buffer)))
+      (if process
+	  (switch-to-buffer buffer)
+	(if (or (not (buffer-file-name buffer))
+		(yes-or-no-p (concat "Buffer "
+				     (buffer-name buffer)
+				     " contains file "
+				     (buffer-file-name buffer)
+				     "; start scheme in it? ")))
+	    (progn
+	      (scheme-start (read-scheme-command-line t)
+			    buffer-name
+			    buffer-name)
+	      (if globally
+		  (global-set-scheme-interaction-buffer buffer-name)))
+	  (message "start-scheme aborted"))))))
+
+(fset 'select-scheme 'start-scheme)
+
+(defun global-set-scheme-interaction-buffer (buffer-name)
+  "Set the default scheme interaction buffer."
+  (interactive
+   (list (read-buffer "Scheme interaction buffer: "
+		      xscheme-buffer-name
+		      t)))
+  (let ((process-name (verify-xscheme-buffer buffer-name nil)))
+    (setq-default xscheme-buffer-name buffer-name)
+    (setq-default xscheme-process-name process-name)
+    (setq-default xscheme-runlight-string
+		  (save-excursion (set-buffer buffer-name)
+				  xscheme-runlight-string))
+    (setq-default xscheme-runlight
+		  (if (eq (process-status process-name) 'run)
+		      default-xscheme-runlight
+		    ""))))
+
+(defun local-set-scheme-interaction-buffer (buffer-name)
+  "Set the scheme interaction buffer for the current buffer."
+  (interactive
+   (list (read-buffer "Scheme interaction buffer: "
+		      xscheme-buffer-name
+		      t)))
+  (let ((process-name (verify-xscheme-buffer buffer-name t)))
+    (make-local-variable 'xscheme-buffer-name)
+    (setq xscheme-buffer-name buffer-name)
+    (make-local-variable 'xscheme-process-name)
+    (setq xscheme-process-name process-name)
+    (make-local-variable 'xscheme-runlight)
+    (setq xscheme-runlight (save-excursion (set-buffer buffer-name)
+					   xscheme-runlight))))
+
+(defun local-clear-scheme-interaction-buffer ()
+  "Make the current buffer use the default scheme interaction buffer."
+  (interactive)
+  (if (xscheme-process-buffer-current-p)
+      (error "Cannot change the interaction buffer of an interaction buffer"))
+  (kill-local-variable 'xscheme-buffer-name)
+  (kill-local-variable 'xscheme-process-name)
+  (kill-local-variable 'xscheme-runlight))
+  
+(defun verify-xscheme-buffer (buffer-name localp)
+  (if (and localp (xscheme-process-buffer-current-p))
+      (error "Cannot change the interaction buffer of an interaction buffer"))
+  (let* ((buffer (get-buffer buffer-name))
+	 (process (and buffer (get-buffer-process buffer))))
+    (cond ((not buffer)
+	   (error "Buffer does not exist" buffer-name))
+	  ((not process)
+	   (error "Buffer is not a scheme interaction buffer" buffer-name))
+	  (t
+	   (save-excursion
+	     (set-buffer buffer)
+	     (if (not (xscheme-process-buffer-current-p))
+		 (error "Buffer is not a scheme interaction buffer"
+			buffer-name)))
+	   (process-name process)))))
+
+;;;; Interaction Mode
+
+(defun scheme-interaction-mode (&optional preserve)
+  "Major mode for interacting with the inferior Scheme process.
+Like  scheme-mode  except that:
+
+\\[advertised-xscheme-send-previous-expression] sends the expression before point to the Scheme process as input
+\\[xscheme-yank-pop] yanks an expression previously sent to Scheme
+\\[xscheme-yank-push] yanks an expression more recently sent to Scheme
+
+All output from the Scheme process is written in the Scheme process
+buffer, which is initially named \"*scheme*\".  The result of
+evaluating a Scheme expression is also printed in the process buffer,
+preceded by the string \";Value: \" to highlight it.  If the process
+buffer is not visible at that time, the value will also be displayed
+in the minibuffer.  If an error occurs, the process buffer will
+automatically pop up to show you the error message.
+
+While the Scheme process is running, the modelines of all buffers in
+scheme-mode are modified to show the state of the process.  The
+possible states and their meanings are:
+
+input		waiting for input
+run		evaluating
+gc		garbage collecting
+
+The process buffer's modeline contains additional information where
+the buffer's name is normally displayed: the command interpreter level
+and type.
+
+Scheme maintains a stack of command interpreters.  Every time an error
+or breakpoint occurs, the current command interpreter is pushed on the
+command interpreter stack, and a new command interpreter is started.
+One example of why this is done is so that an error that occurs while
+you are debugging another error will not destroy the state of the
+initial error, allowing you to return to it after the second error has
+been fixed.
+
+The command interpreter level indicates how many interpreters are in
+the command interpreter stack.  It is initially set to one, and it is
+incremented every time that stack is pushed, and decremented every
+time it is popped.  The following commands are useful for manipulating
+the command interpreter stack:
+
+\\[xscheme-send-breakpoint-interrupt]	pushes the stack once
+\\[xscheme-send-control-u-interrupt]	pops the stack once
+\\[xscheme-send-control-g-interrupt]	pops everything off
+\\[xscheme-send-control-x-interrupt]	aborts evaluation, doesn't affect stack
+
+Some possible command interpreter types and their meanings are:
+
+[Evaluator]	read-eval-print loop for evaluating expressions
+[Debugger]	single character commands for debugging errors
+[Where]		single character commands for examining environments
+
+Starting with release 6.2 of Scheme, the latter two types of command
+interpreters will change the major mode of the Scheme process buffer
+to scheme-debugger-mode , in which the evaluation commands are
+disabled, and the keys which normally self insert instead send
+themselves to the Scheme process.  The command character ? will list
+the available commands.
+
+For older releases of Scheme, the major mode will be
+scheme-interaction-mode , and the command characters must be sent as
+if they were expressions.
+
+Commands:
+Delete converts tabs to spaces as it moves back.
+Blank lines separate paragraphs.  Semicolons start comments.
+\\{scheme-interaction-mode-map}
+
+Entry to this mode calls the value of scheme-interaction-mode-hook
+with no args, if that value is non-nil.
+ Likewise with the value of scheme-mode-hook.
+ scheme-interaction-mode-hook is called after scheme-mode-hook."
+
+  (interactive "P")
+  (if (not preserve)
+      (let ((previous-mode major-mode))
+        (kill-all-local-variables)
+        (make-local-variable 'xscheme-previous-mode)
+        (make-local-variable 'xscheme-buffer-name)
+        (make-local-variable 'xscheme-process-name)
+        (make-local-variable 'xscheme-previous-process-state)
+        (make-local-variable 'xscheme-runlight-string)
+        (make-local-variable 'xscheme-runlight)
+        (setq xscheme-previous-mode previous-mode)
+        (let ((buffer (current-buffer)))
+          (setq xscheme-buffer-name (buffer-name buffer))
+          (let ((process (get-buffer-process buffer)))
+            (if (not process)
+                (setq xscheme-previous-process-state (cons nil nil))
+                (progn
+                  (setq xscheme-process-name (process-name process))
+                  (setq xscheme-previous-process-state
+                        (cons (process-filter process)
+                              (process-sentinel process)))
+		  (xscheme-process-filter-initialize t)
+		  (xscheme-modeline-initialize xscheme-buffer-name)
+		  (set-process-sentinel process 'xscheme-process-sentinel)
+		  (set-process-filter process 'xscheme-process-filter)))))))
+  (scheme-interaction-mode-initialize)
+  (scheme-mode-variables)
+  (run-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook))
+
+(defun exit-scheme-interaction-mode ()
+  "Take buffer out of scheme interaction mode"
+  (interactive)
+  (if (not (eq major-mode 'scheme-interaction-mode))
+      (error "Buffer not in scheme interaction mode"))
+  (let ((previous-state xscheme-previous-process-state))
+    (funcall xscheme-previous-mode)
+    (let ((process (get-buffer-process (current-buffer))))
+      (if process
+	  (progn
+	    (if (eq (process-filter process) 'xscheme-process-filter)
+		(set-process-filter process (car previous-state)))
+	    (if (eq (process-sentinel process) 'xscheme-process-sentinel)
+		(set-process-sentinel process (cdr previous-state))))))))	
+
+(defun scheme-interaction-mode-initialize ()
+  (use-local-map scheme-interaction-mode-map)
+  (setq major-mode 'scheme-interaction-mode)
+  (setq mode-name "Scheme Interaction"))
+
+(defun scheme-interaction-mode-commands (keymap)
+  (define-key keymap "\C-c\C-m" 'xscheme-send-current-line)
+  (define-key keymap "\C-c\C-p" 'xscheme-send-proceed)
+  (define-key keymap "\C-c\C-y" 'xscheme-yank)
+  (define-key keymap "\ep" 'xscheme-yank-pop)
+  (define-key keymap "\en" 'xscheme-yank-push))
+
+(defvar scheme-interaction-mode-map nil)
+(if (not scheme-interaction-mode-map)
+    (progn
+      (setq scheme-interaction-mode-map (make-keymap))
+      (scheme-mode-commands scheme-interaction-mode-map)
+      (xscheme-interrupt-commands scheme-interaction-mode-map)
+      (xscheme-evaluation-commands scheme-interaction-mode-map)
+      (scheme-interaction-mode-commands scheme-interaction-mode-map)))
+
+(defun xscheme-enter-interaction-mode ()
+  (save-excursion
+    (set-buffer (xscheme-process-buffer))
+    (if (not (eq major-mode 'scheme-interaction-mode))
+	(if (eq major-mode 'scheme-debugger-mode)
+	    (scheme-interaction-mode-initialize)
+	    (scheme-interaction-mode t)))))
+
+(fset 'advertised-xscheme-send-previous-expression
+      'xscheme-send-previous-expression)
+
+;;;; Debugger Mode
+
+(defun scheme-debugger-mode ()
+  "Major mode for executing the Scheme debugger.
+Like  scheme-mode  except that the evaluation commands
+are disabled, and characters that would normally be self inserting are
+sent to the Scheme process instead.  Typing ?  will show you which
+characters perform useful functions.
+
+Commands:
+\\{scheme-debugger-mode-map}"
+  (error "Illegal entry to scheme-debugger-mode"))
+
+(defun scheme-debugger-mode-initialize ()
+  (use-local-map scheme-debugger-mode-map)
+  (setq major-mode 'scheme-debugger-mode)
+  (setq mode-name "Scheme Debugger"))
+
+(defun scheme-debugger-mode-commands (keymap)
+  (let ((char ? ))
+    (while (< char 127)
+      (define-key keymap (char-to-string char) 'scheme-debugger-self-insert)
+      (setq char (1+ char)))))
+
+(defvar scheme-debugger-mode-map nil)
+(if (not scheme-debugger-mode-map)
+    (progn
+      (setq scheme-debugger-mode-map (make-keymap))
+      (scheme-mode-commands scheme-debugger-mode-map)
+      (xscheme-interrupt-commands scheme-debugger-mode-map)
+      (scheme-debugger-mode-commands scheme-debugger-mode-map)))
+
+(defun scheme-debugger-self-insert ()
+  "Transmit this character to the Scheme process."
+  (interactive)
+  (xscheme-send-char last-command-char))
+
+(defun xscheme-enter-debugger-mode (prompt-string)
+  (save-excursion
+    (set-buffer (xscheme-process-buffer))
+    (if (not (eq major-mode 'scheme-debugger-mode))
+	(progn
+	  (if (not (eq major-mode 'scheme-interaction-mode))
+	      (scheme-interaction-mode t))
+	  (scheme-debugger-mode-initialize)))))
+
+(defun xscheme-debugger-mode-p ()
+  (let ((buffer (xscheme-process-buffer)))
+    (and buffer
+	 (save-excursion
+	   (set-buffer buffer)
+	   (eq major-mode 'scheme-debugger-mode)))))
+
+;;;; Evaluation Commands
+
+(defun xscheme-send-string (&rest strings)
+  "Send the string arguments to the Scheme process.
+The strings are concatenated and terminated by a newline."
+  (cond ((not (xscheme-process-running-p))
+	 (if (yes-or-no-p "The Scheme process has died.  Reset it? ")
+	     (progn
+	       (reset-scheme)
+	       (xscheme-wait-for-process)
+	       (xscheme-send-string-1 strings))))
+	((xscheme-debugger-mode-p) (error "No sends allowed in debugger mode"))
+	((and (not xscheme-allow-pipelined-evaluation)
+	      xscheme-running-p)
+	 (error "No sends allowed while Scheme running"))
+	(t (xscheme-send-string-1 strings))))
+
+(defun xscheme-send-string-1 (strings)
+  (let ((string (apply 'concat strings)))
+    (xscheme-send-string-2 string)
+    (if (eq major-mode 'scheme-interaction-mode)
+	(xscheme-insert-expression string))))
+
+(defun xscheme-send-string-2 (string)
+  (let ((process (get-process xscheme-process-name)))
+    (process-send-string process (concat string "\n"))
+    (if (xscheme-process-buffer-current-p)
+	(set-marker (process-mark process) (point)))))
+
+(defun xscheme-select-process-buffer ()
+  "Select the Scheme process buffer and move to its output point."
+  (interactive)
+  (let ((process (or (get-process xscheme-process-name)
+		     (error "No scheme process"))))
+    (let ((buffer (or (process-buffer process) (error "No process buffer"))))
+      (let ((window (get-buffer-window buffer)))
+	(if window
+	    (select-window window)
+	    (switch-to-buffer buffer))
+	(goto-char (process-mark process))))))
+
+;;;; Scheme expressions ring
+
+(defun xscheme-insert-expression (string)
+  (setq xscheme-expressions-ring (cons string xscheme-expressions-ring))
+  (if (> (length xscheme-expressions-ring) xscheme-expressions-ring-max)
+      (setcdr (nthcdr (1- xscheme-expressions-ring-max) xscheme-expressions-ring) nil))
+  (setq xscheme-expressions-ring-yank-pointer xscheme-expressions-ring))
+
+(defun xscheme-rotate-yank-pointer (arg)
+  "Rotate the yanking point in the kill ring."
+  (interactive "p")
+  (let ((length (length xscheme-expressions-ring)))
+    (if (zerop length)
+	(error "Scheme expression ring is empty")
+      (setq xscheme-expressions-ring-yank-pointer
+	    (let ((index (% (+ arg (- length (length xscheme-expressions-ring-yank-pointer)))
+			    length)))
+	    (nthcdr (if (< index 0)
+			(+ index length)
+		      index)
+		    xscheme-expressions-ring))))))
+
+(defun xscheme-yank (&optional arg)
+  "Insert the most recent expression at point.
+With just C-U as argument, same but put point in front (and mark at end).
+With argument n, reinsert the nth most recently sent expression.
+See also the commands \\[xscheme-yank-pop] and \\[xscheme-yank-push]."
+  (interactive "*P")
+  (xscheme-rotate-yank-pointer (if (listp arg) 0
+				 (if (eq arg '-) -1
+				   (1- arg))))
+  (push-mark (point))
+  (insert (car xscheme-expressions-ring-yank-pointer))
+  (if (consp arg)
+      (exchange-point-and-mark)))
+
+;; Old name, to avoid errors in users' init files.
+
+(fset 'xscheme-yank-previous-send
+      'xscheme-yank)
+
+(defun xscheme-yank-pop (arg)
+  "Insert or replace a just-yanked expression with an older expression.
+If the previous command was not a yank, it yanks.
+Otherwise, the region contains a stretch of reinserted
+expression.  yank-pop deletes that text and inserts in its
+place a different expression.
+
+With no argument, the next older expression is inserted.
+With argument n, the n'th older expression is inserted.
+If n is negative, this is a more recent expression.
+
+The sequence of expressions wraps around, so that after the oldest one
+comes the newest one."
+  (interactive "*p")
+  (setq this-command 'xscheme-yank)
+  (if (not (eq last-command 'xscheme-yank))
+      (progn
+	(xscheme-yank)
+	(setq arg (- arg 1))))
+  (if (not (= arg 0))
+      (let ((before (< (point) (mark t))))
+	(delete-region (point) (mark t))
+	(xscheme-rotate-yank-pointer arg)
+	(set-mark (point))
+	(insert (car xscheme-expressions-ring-yank-pointer))
+	(if before (exchange-point-and-mark)))))
+
+(defun xscheme-yank-push (arg)
+  "Insert or replace a just-yanked expression with a more recent expression.
+If the previous command was not a yank, it yanks.
+Otherwise, the region contains a stretch of reinserted
+expression.  yank-pop deletes that text and inserts in its
+place a different expression.
+
+With no argument, the next more recent expression is inserted.
+With argument n, the n'th more recent expression is inserted.
+If n is negative, a less recent expression is used.
+
+The sequence of expressions wraps around, so that after the oldest one
+comes the newest one."
+  (interactive "*p")
+  (xscheme-yank-pop (- 0 arg)))
+
+(defun xscheme-send-region (start end)
+  "Send the current region to the Scheme process.
+The region is sent terminated by a newline."
+  (interactive "r")
+  (if (xscheme-process-buffer-current-p)
+      (progn (goto-char end)
+	     (set-marker (process-mark (get-process xscheme-process-name))
+			 end)))
+  (xscheme-send-string (buffer-substring start end)))
+
+(defun xscheme-send-definition ()
+  "Send the current definition to the Scheme process.
+If the current line begins with a non-whitespace character,
+parse an expression from the beginning of the line and send that instead."
+  (interactive)
+  (let ((start nil) (end nil))
+    (save-excursion
+      (end-of-defun)
+      (setq end (point))
+      (if (re-search-backward "^\\s(" nil t)
+	  (setq start (point))
+	  (error "Can't find definition")))
+    (xscheme-send-region start end)))
+
+(defun xscheme-send-next-expression ()
+  "Send the expression to the right of `point' to the Scheme process."
+  (interactive)
+  (let ((start (point)))
+    (xscheme-send-region start (save-excursion (forward-sexp) (point)))))
+
+(defun xscheme-send-previous-expression ()
+  "Send the expression to the left of `point' to the Scheme process."
+  (interactive)
+  (let ((end (point)))
+    (xscheme-send-region (save-excursion (backward-sexp) (point)) end)))
+
+(defun xscheme-send-current-line ()
+  "Send the current line to the Scheme process.
+Useful for working with debugging Scheme under adb."
+  (interactive)
+  (let ((line
+	 (save-excursion
+	   (beginning-of-line)
+	   (let ((start (point)))
+	     (end-of-line)
+	     (buffer-substring start (point))))))
+    (end-of-line)
+    (insert ?\n)
+    (xscheme-send-string-2 line)))
+
+(defun xscheme-send-buffer ()
+  "Send the current buffer to the Scheme process."
+  (interactive)
+  (if (xscheme-process-buffer-current-p)
+      (error "Not allowed to send this buffer's contents to Scheme"))
+  (xscheme-send-region (point-min) (point-max)))
+
+(defun xscheme-send-char (char)
+  "Prompt for a character and send it to the Scheme process."
+  (interactive "cCharacter to send: ")
+  (process-send-string xscheme-process-name (char-to-string char)))
+
+;;;; Interrupts
+
+(defun xscheme-send-breakpoint-interrupt ()
+  "Cause the Scheme process to enter a breakpoint."
+  (interactive)
+  (xscheme-send-interrupt ?b nil))
+
+(defun xscheme-send-proceed ()
+  "Cause the Scheme process to proceed from a breakpoint."
+  (interactive)
+  (process-send-string xscheme-process-name "(proceed)\n"))
+
+(defun buffer-local-value-cell (buffer name)
+  (let ((pair (assq name (buffer-local-variables (get-buffer buffer)))))
+    (if (not pair)
+	(error "buffer-local-value-cell: Not bound")
+      pair)))
+
+(defun xscheme-send-control-g-interrupt ()
+  "Cause the Scheme processor to halt and flush input.
+Control returns to the top level rep loop."
+  (interactive)
+  (let* ((inhibit-quit t)
+	 (vcell (buffer-local-value-cell xscheme-buffer-name
+					 'xscheme-control-g-disabled-p)))
+    (cond ((not xscheme-control-g-synchronization-p)
+	   (interrupt-process xscheme-process-name))
+	  ((cdr vcell)
+	   (message "Relax..."))
+	  (t
+	   (rplacd vcell t)
+	   (message "Sending C-G interrupt to Scheme...")
+	   (interrupt-process xscheme-process-name)
+	   (process-send-string xscheme-process-name (char-to-string 0))))))
+
+(defun xscheme-send-control-u-interrupt ()
+  "Cause the Scheme process to halt, returning to previous rep loop."
+  (interactive)
+  (xscheme-send-interrupt ?u t))
+
+(defun xscheme-send-control-x-interrupt ()
+  "Cause the Scheme process to halt, returning to current rep loop."
+  (interactive)
+  (xscheme-send-interrupt ?x t))
+
+;;; This doesn't really work right -- Scheme just gobbles the first
+;;; character in the input.  There is no way for us to guarantee that
+;;; the argument to this procedure is the first char unless we put
+;;; some kind of marker in the input stream.
+
+(defun xscheme-send-interrupt (char mark-p)
+  "Send a ^A type interrupt to the Scheme process."
+  (interactive "cInterrupt character to send: ")
+  (quit-process xscheme-process-name)
+  (process-send-string xscheme-process-name (char-to-string char))
+  (if (and mark-p xscheme-control-g-synchronization-p)
+      (process-send-string xscheme-process-name (char-to-string 0))))
+
+;;;; Internal Variables
+
+(defvar xscheme-process-command-line nil
+  "Command used to start the most recent Scheme process.")
+
+(defvar xscheme-expressions-ring-max 30
+  "*Maximum length of Scheme expressions ring.")
+
+(defvar xscheme-expressions-ring nil
+  "List of expressions recently transmitted to the Scheme process.")
+
+(defvar xscheme-expressions-ring-yank-pointer nil
+  "The tail of the Scheme expressions ring whose car is the last thing yanked.")
+
+(defvar xscheme-process-filter-state 'idle
+  "State of scheme process escape reader state machine:
+idle                   waiting for an escape sequence
+reading-type           received an altmode but nothing else
+reading-string         reading prompt string")
+
+(defvar xscheme-running-p nil
+  "This variable, if nil, indicates that the scheme process is
+waiting for input.  Otherwise, it is busy evaluating something.")
+
+(defconst xscheme-control-g-synchronization-p t
+  "If non-nil, insert markers in the scheme input stream to indicate when
+control-g interrupts were signalled.  Do not allow more control-g's to be
+signalled until the scheme process acknowledges receipt.")
+
+(defvar xscheme-control-g-disabled-p nil
+  "This variable, if non-nil, indicates that a control-g is being processed
+by the scheme process, so additional control-g's are to be ignored.")
+
+(defvar xscheme-allow-output-p t
+  "This variable, if nil, prevents output from the scheme process
+from being inserted into the process-buffer.")
+
+(defvar xscheme-prompt ""
+  "The current scheme prompt string.")
+
+(defvar xscheme-string-accumulator ""
+  "Accumulator for the string being received from the scheme process.")
+
+(defvar xscheme-string-receiver nil
+  "Procedure to send the string argument from the scheme process.")
+
+(defvar xscheme-start-hook nil
+  "If non-nil, a procedure to call when the Scheme process is started.
+When called, the current buffer will be the Scheme process-buffer.")
+
+(defvar xscheme-runlight "")
+(defvar xscheme-runlight-string nil)
+(defvar xscheme-mode-string nil)
+(setq-default scheme-mode-line-process
+	      '("" xscheme-runlight))
+
+(mapcar 'make-variable-buffer-local
+	'(xscheme-expressions-ring
+	  xscheme-expressions-ring-yank-pointer
+	  xscheme-process-filter-state
+	  xscheme-running-p
+	  xscheme-control-g-disabled-p
+	  xscheme-allow-output-p
+	  xscheme-prompt
+	  xscheme-string-accumulator
+	  xscheme-mode-string
+	  scheme-mode-line-process))
+
+;;;; Basic Process Control
+
+(defun xscheme-start-process (command-line the-process the-buffer)
+  (let ((buffer (get-buffer-create the-buffer)))
+    (let ((process (get-buffer-process buffer)))
+      (save-excursion
+	(set-buffer buffer)
+	(if (and process (memq (process-status process) '(run stop)))
+	    (set-marker (process-mark process) (point-max))
+	    (progn (if process (delete-process process))
+		   (goto-char (point-max))
+		   (scheme-interaction-mode nil)
+		   (setq xscheme-process-name the-process)
+		   (if (bobp)
+		       (insert-before-markers
+			(substitute-command-keys xscheme-startup-message)))
+		   (setq process
+			 (let ((process-connection-type nil))
+			   (apply 'start-process
+				  (cons the-process
+					(cons buffer
+					      (xscheme-parse-command-line
+					       command-line))))))
+		   (if (not (equal (process-name process) the-process))
+		       (setq xscheme-process-name (process-name process)))
+		   (if (not (equal (buffer-name buffer) the-buffer))
+		       (setq xscheme-buffer-name (buffer-name buffer)))
+		   (message "Starting process %s in buffer %s"
+			    xscheme-process-name
+			    xscheme-buffer-name)
+		   (set-marker (process-mark process) (point-max))
+		   (xscheme-process-filter-initialize t)
+		   (xscheme-modeline-initialize xscheme-buffer-name)
+		   (set-process-sentinel process 'xscheme-process-sentinel)
+		   (set-process-filter process 'xscheme-process-filter)
+		   (run-hooks 'xscheme-start-hook)))))
+    buffer))
+
+(defun xscheme-parse-command-line (string)
+  (setq string (substitute-in-file-name string))
+  (let ((start 0)
+	(result '()))
+    (while start
+      (let ((index (string-match "[ \t]" string start)))
+	(setq start
+	      (cond ((not index)
+		     (setq result
+			   (cons (substring string start)
+				 result))
+		     nil)
+		    ((= index start)
+		     (string-match "[^ \t]" string start))
+		    (t
+		     (setq result
+			   (cons (substring string start index)
+				 result))
+		     (1+ index))))))
+    (nreverse result)))
+
+(defun xscheme-wait-for-process ()
+  (sleep-for 2)
+  (while xscheme-running-p
+    (sleep-for 1)))
+
+(defun xscheme-process-running-p ()
+  "True iff there is a Scheme process whose status is `run'."
+  (let ((process (get-process xscheme-process-name)))
+    (and process
+	 (eq (process-status process) 'run))))
+
+(defun xscheme-process-buffer ()
+  (let ((process (get-process xscheme-process-name)))
+    (and process (process-buffer process))))
+
+(defun xscheme-process-buffer-window ()
+  (let ((buffer (xscheme-process-buffer)))
+    (and buffer (get-buffer-window buffer))))
+
+(defun xscheme-process-buffer-current-p ()
+  "True iff the current buffer is the Scheme process buffer."
+  (eq (xscheme-process-buffer) (current-buffer)))
+
+;;;; Process Filter
+
+(defun xscheme-process-sentinel (proc reason)
+  (let* ((buffer (process-buffer proc))
+	 (name (buffer-name buffer)))
+    (save-excursion
+      (set-buffer buffer)
+      (xscheme-process-filter-initialize (eq reason 'run))
+      (if (not (eq reason 'run))
+	(progn
+	  (setq scheme-mode-line-process "")
+	  (setq xscheme-mode-string "no process")
+	  (if (equal name (default-value 'xscheme-buffer-name))
+	      (setq-default xscheme-runlight ""))))
+      (if (and (not (memq reason '(run stop)))
+	       xscheme-signal-death-message)
+	  (progn (beep)
+		 (message
+"The Scheme process has died!  Do M-x reset-scheme to restart it"))))))
+
+(defun xscheme-process-filter-initialize (running-p)
+  (setq xscheme-process-filter-state 'idle)
+  (setq xscheme-running-p running-p)
+  (setq xscheme-control-g-disabled-p nil)
+  (setq xscheme-allow-output-p t)
+  (setq xscheme-prompt "")
+  (if running-p
+      (let ((name (buffer-name (current-buffer))))
+	(setq scheme-mode-line-process '(": " xscheme-runlight-string))
+	(xscheme-modeline-initialize name)
+	(if (equal name (default-value 'xscheme-buffer-name))
+	    (setq-default xscheme-runlight default-xscheme-runlight))))
+  (if (or (eq xscheme-runlight default-xscheme-runlight)
+	  (equal xscheme-runlight ""))
+      (setq xscheme-runlight (list ": " 'xscheme-buffer-name ": " "?")))
+  (rplaca (nthcdr 3 xscheme-runlight)
+	  (if running-p "?" "no process")))
+
+(defun xscheme-process-filter (proc string)
+  (save-excursion
+    (set-buffer (process-buffer proc))
+    (let ((xscheme-filter-input string))
+      (while xscheme-filter-input
+	(cond ((eq xscheme-process-filter-state 'idle)
+	       (let ((start (string-match "\e" xscheme-filter-input)))
+		 (if start
+		     (progn
+		       (xscheme-process-filter-output
+			(substring xscheme-filter-input 0 start))
+		       (setq xscheme-filter-input
+			     (substring xscheme-filter-input (1+ start)))
+		       (setq xscheme-process-filter-state 'reading-type))
+		   (let ((string xscheme-filter-input))
+		     (setq xscheme-filter-input nil)
+		     (xscheme-process-filter-output string)))))
+	      ((eq xscheme-process-filter-state 'reading-type)
+	       (if (zerop (length xscheme-filter-input))
+		   (setq xscheme-filter-input nil)
+		 (let ((char (aref xscheme-filter-input 0)))
+		   (setq xscheme-filter-input
+			 (substring xscheme-filter-input 1))
+		   (let ((entry (assoc char xscheme-process-filter-alist)))
+		     (if entry
+			 (funcall (nth 2 entry) (nth 1 entry))
+		       (progn
+			 (xscheme-process-filter-output ?\e char)
+			 (setq xscheme-process-filter-state 'idle)))))))
+	      ((eq xscheme-process-filter-state 'reading-string)
+	       (let ((start (string-match "\e" xscheme-filter-input)))
+		 (if start
+		     (let ((string
+			    (concat xscheme-string-accumulator
+				    (substring xscheme-filter-input 0 start))))
+		       (setq xscheme-filter-input
+			     (substring xscheme-filter-input (1+ start)))
+		       (setq xscheme-process-filter-state 'idle)
+		       (funcall xscheme-string-receiver string))
+		   (progn
+		     (setq xscheme-string-accumulator
+			   (concat xscheme-string-accumulator
+				   xscheme-filter-input))
+		     (setq xscheme-filter-input nil)))))
+	      (t
+	       (error "Scheme process filter -- bad state")))))))
+
+;;;; Process Filter Output
+
+(defun xscheme-process-filter-output (&rest args)
+  (if xscheme-allow-output-p
+      (let ((string (apply 'concat args)))
+	(save-excursion
+	  (xscheme-goto-output-point)
+	  (while (string-match "\\(\007\\|\f\\)" string)
+	    (let ((start (match-beginning 0))
+		  (end (match-end 0)))
+	      (insert-before-markers (substring string 0 start))
+	      (if (= ?\f (aref string start))
+		  (progn
+		    (if (not (bolp))
+			(insert-before-markers ?\n))
+		    (insert-before-markers ?\f))
+		  (beep))
+	      (setq string (substring string (1+ start)))))
+	  (insert-before-markers string)))))
+
+(defun xscheme-guarantee-newlines (n)
+  (if xscheme-allow-output-p
+      (save-excursion
+	(xscheme-goto-output-point)
+	(let ((stop nil))
+	  (while (and (not stop)
+		      (bolp))
+	    (setq n (1- n))
+	    (if (bobp)
+		(setq stop t)
+		(backward-char))))
+	(xscheme-goto-output-point)
+	(while (> n 0)
+	  (insert-before-markers ?\n)
+	  (setq n (1- n))))))
+
+(defun xscheme-goto-output-point ()
+  (let ((process (get-process xscheme-process-name)))
+    (set-buffer (process-buffer process))
+    (goto-char (process-mark process))))
+
+(defun xscheme-modeline-initialize (name)
+  (setq xscheme-runlight-string "")
+  (if (equal name (default-value 'xscheme-buffer-name))
+      (setq-default xscheme-runlight-string ""))
+  (setq xscheme-mode-string "")
+  (setq mode-line-buffer-identification
+	(list (concat name ": ")
+	      'xscheme-mode-string)))
+
+(defun xscheme-set-runlight (runlight)
+  (setq xscheme-runlight-string runlight)
+  (if (equal (buffer-name (current-buffer))
+	     (default-value 'xscheme-buffer-name))
+      (setq-default xscheme-runlight-string runlight))
+  (rplaca (nthcdr 3 xscheme-runlight) runlight)
+  (xscheme-modeline-redisplay))
+
+(defun xscheme-modeline-redisplay ()
+  (save-excursion (set-buffer (other-buffer)))
+  (set-buffer-modified-p (buffer-modified-p))
+  (sit-for 0))
+
+;;;; Process Filter Operations
+
+(defvar xscheme-process-filter-alist
+  '((?D xscheme-enter-debugger-mode
+	xscheme-process-filter:string-action)
+    (?E xscheme-eval
+	xscheme-process-filter:string-action)
+    (?P xscheme-set-prompt-variable
+	xscheme-process-filter:string-action)
+    (?R xscheme-enter-interaction-mode
+	xscheme-process-filter:simple-action)
+    (?b xscheme-start-gc
+	xscheme-process-filter:simple-action)
+    (?e xscheme-finish-gc
+	xscheme-process-filter:simple-action)
+    (?f xscheme-exit-input-wait
+	xscheme-process-filter:simple-action)
+    (?g xscheme-enable-control-g
+	xscheme-process-filter:simple-action)
+    (?i xscheme-prompt-for-expression
+	xscheme-process-filter:string-action)
+    (?m xscheme-message
+	xscheme-process-filter:string-action)
+    (?n xscheme-prompt-for-confirmation
+	xscheme-process-filter:string-action)
+    (?o xscheme-output-goto
+	xscheme-process-filter:simple-action)
+    (?p xscheme-set-prompt
+	xscheme-process-filter:string-action)
+    (?s xscheme-enter-input-wait
+	xscheme-process-filter:simple-action)
+    (?v xscheme-write-value
+	xscheme-process-filter:string-action)
+    (?w xscheme-cd
+	xscheme-process-filter:string-action)
+    (?z xscheme-display-process-buffer
+	xscheme-process-filter:simple-action)
+    (?c xscheme-unsolicited-read-char
+	xscheme-process-filter:simple-action))
+  "Table used to decide how to handle process filter commands.
+Value is a list of entries, each entry is a list of three items.
+
+The first item is the character that the process filter dispatches on.
+The second item is the action to be taken, a function.
+The third item is the handler for the entry, a function.
+
+When the process filter sees a command whose character matches a
+particular entry, it calls the handler with two arguments: the action
+and the string containing the rest of the process filter's input
+stream.  It is the responsibility of the handler to invoke the action
+with the appropriate arguments, and to reenter the process filter with
+the remaining input.")
+
+(defun xscheme-process-filter:simple-action (action)
+  (setq xscheme-process-filter-state 'idle)
+  (funcall action))
+
+(defun xscheme-process-filter:string-action (action)
+  (setq xscheme-string-receiver action)
+  (setq xscheme-string-accumulator "")
+  (setq xscheme-process-filter-state 'reading-string))
+
+(defconst xscheme-runlight:running "run"
+  "The character displayed when the Scheme process is running.")
+
+(defconst xscheme-runlight:input "input"
+  "The character displayed when the Scheme process is waiting for input.")
+
+(defconst xscheme-runlight:gc "gc"
+  "The character displayed when the Scheme process is garbage collecting.")
+
+(defun xscheme-start-gc ()
+  (xscheme-set-runlight xscheme-runlight:gc))
+
+(defun xscheme-finish-gc ()
+  (xscheme-set-runlight
+   (if xscheme-running-p xscheme-runlight:running xscheme-runlight:input)))
+
+(defun xscheme-enter-input-wait ()
+  (xscheme-set-runlight xscheme-runlight:input)
+  (setq xscheme-control-g-disabled-p nil)
+  (setq xscheme-running-p nil))
+
+(defun xscheme-exit-input-wait ()
+  (xscheme-set-runlight xscheme-runlight:running)
+  (setq xscheme-running-p t))
+
+(defun xscheme-enable-control-g ()
+  (setq xscheme-control-g-disabled-p nil))
+
+(defun xscheme-display-process-buffer ()
+  (let ((window (or (xscheme-process-buffer-window)
+		    (display-buffer (xscheme-process-buffer)))))
+    (save-window-excursion
+      (select-window window)
+      (xscheme-goto-output-point)
+      (if (xscheme-debugger-mode-p)
+	  (xscheme-enter-interaction-mode)))))
+
+(defun xscheme-unsolicited-read-char ()
+  nil)
+
+(defun xscheme-eval (string)
+  (eval (car (read-from-string string))))
+
+(defun xscheme-message (string)
+  (if (not (zerop (length string)))
+      (xscheme-write-message-1 string (format ";%s" string))))
+
+(defun xscheme-write-value (string)
+  (if (zerop (length string))
+      (xscheme-write-message-1 "(no value)" ";No value")
+      (xscheme-write-message-1 string (format ";Value: %s" string))))
+
+(defun xscheme-write-message-1 (message-string output-string)
+  (let* ((process (get-process xscheme-process-name))
+	 (window (get-buffer-window (process-buffer process))))
+    (if (or (not window)
+	    (not (pos-visible-in-window-p (process-mark process)
+					  window)))
+	(message "%s" message-string)))
+  (xscheme-guarantee-newlines 1)
+  (xscheme-process-filter-output output-string))
+
+(defun xscheme-set-prompt-variable (string)
+  (setq xscheme-prompt string))
+
+(defun xscheme-set-prompt (string)
+  (setq xscheme-prompt string)
+  (xscheme-guarantee-newlines 2)
+  (setq xscheme-mode-string (xscheme-coerce-prompt string))
+  (xscheme-modeline-redisplay))
+
+(defun xscheme-output-goto ()
+  (xscheme-goto-output-point)
+  (xscheme-guarantee-newlines 2))
+
+(defun xscheme-coerce-prompt (string)
+  (if (string-match "^[0-9]+ \\[[^]]+\\] " string)
+      (let ((end (match-end 0)))
+	(let ((prompt (substring string end)))
+	  (xscheme-process-filter-output prompt)
+	  (if (and (> (length prompt) 0)
+		   (not (= (aref prompt (- (length prompt) 1)) ? )))
+	      (xscheme-process-filter-output " "))
+	  (substring string 0 (- end 1))))
+      string))
+
+(defun xscheme-cd (directory-string)
+  (save-excursion
+    (set-buffer (xscheme-process-buffer))
+    (cd directory-string)))
+
+(defun xscheme-prompt-for-confirmation (prompt-string)
+  (xscheme-send-char (if (y-or-n-p prompt-string) ?y ?n)))
+
+(defun xscheme-prompt-for-expression (prompt-string)
+  (xscheme-send-string-2
+   (read-from-minibuffer prompt-string nil xscheme-prompt-for-expression-map)))
+
+(defvar xscheme-prompt-for-expression-map nil)
+(if (not xscheme-prompt-for-expression-map)
+    (progn
+      (setq xscheme-prompt-for-expression-map
+	    (copy-keymap minibuffer-local-map))
+      (substitute-key-definition 'exit-minibuffer
+				 'xscheme-prompt-for-expression-exit
+				 xscheme-prompt-for-expression-map)))
+
+(defun xscheme-prompt-for-expression-exit ()
+  (interactive)
+  (if (eq (xscheme-region-expression-p (point-min) (point-max)) 'one)
+      (exit-minibuffer)
+      (error "input must be a single, complete expression")))
+
+(defun xscheme-region-expression-p (start end)
+  (save-excursion
+    (let ((old-syntax-table (syntax-table)))
+      (unwind-protect
+	  (progn
+	    (set-syntax-table scheme-mode-syntax-table)
+	    (let ((state (parse-partial-sexp start end)))
+	      (and (zerop (car state))	;depth = 0
+		   (nth 2 state)	;last-sexp exists, i.e. >= 1 sexps
+		   (let ((state (parse-partial-sexp start (nth 2 state))))
+		     (if (nth 2 state) 'many 'one)))))
+	(set-syntax-table old-syntax-table)))))
+
+(provide 'xscheme)
+;;; xscheme.el ends here.