;; Run Scheme under Emacs;; Copyright (C) 1986, 1987, 1989 Free Software Foundation, Inc.;; This file is part of GNU Emacs.;; GNU Emacs 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 1, or (at your option);; any later version.;; GNU Emacs is distributed in the hope that it will be useful,;; but WITHOUT ANY WARRANTY; without even the implied warranty of;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the;; GNU General Public License for more details.;; You should have received a copy of the GNU General Public License;; along with GNU Emacs; see the file COPYING.  If not, write to;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.;;; Requires C-Scheme release 5 or later;;; Changes to Control-G handler require runtime version 13.85 or later;;; $Header: xscheme.el,v 1.23 89/04/28 22:59:40 GMT cph Rel $(require 'scheme)(defvar scheme-program-name "scheme"  "*Program invoked by the `run-scheme' command.")(defvar scheme-band-name nil  "*Band loaded by the `run-scheme' command.")(defvar scheme-program-arguments nil  "*Arguments passed to the Scheme program by the `run-scheme' command.")(defvar 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 expressionhas finished evaluating will signal an error.")(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.")(defvar xscheme-signal-death-message nil  "If non-nil, causes a message to be generated when the Scheme process dies.")(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)(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 (let ((default		 (or xscheme-process-command-line		     (xscheme-default-command-line))))	   (if current-prefix-arg	       (read-string "Run Scheme: " default)	       default))))  (setq xscheme-process-command-line command-line)  (switch-to-buffer (xscheme-start-process command-line)))(defun reset-scheme ()  "Reset the Scheme process."  (interactive)  (let ((process (get-process "scheme")))    (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 (kill-process process t))	   (xscheme-start-process xscheme-process-command-line)	   (message "Resetting Scheme process...done")))))(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)	      "")));;;; Interaction Mode(defun scheme-interaction-mode ()  "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-previous-send] yanks the expression most recently sent to SchemeAll output from the Scheme process is written in the Scheme processbuffer, which is initially named \"*scheme*\".  The result ofevaluating a Scheme expression is also printed in the process buffer,preceded by the string \";Value: \" to highlight it.  If the processbuffer is not visible at that time, the value will also be displayedin the minibuffer.  If an error occurs, the process buffer willautomatically pop up to show you the error message.While the Scheme process is running, the modelines of all buffers inscheme-mode are modified to show the state of the process.  Thepossible states and their meanings are:input		waiting for inputrun		evaluatinggc		garbage collectingThe process buffer's modeline contains additional information wherethe buffer's name is normally displayed: the command interpreter leveland type.Scheme maintains a stack of command interpreters.  Every time an erroror breakpoint occurs, the current command interpreter is pushed on thecommand interpreter stack, and a new command interpreter is started.One example of why this is done is so that an error that occurs whileyou are debugging another error will not destroy the state of theinitial error, allowing you to return to it after the second error hasbeen fixed.The command interpreter level indicates how many interpreters are inthe command interpreter stack.  It is initially set to one, and it isincremented every time that stack is pushed, and decremented everytime it is popped.  The following commands are useful for manipulatingthe 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 stackSome 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 environmentsStarting with release 6.2 of Scheme, the latter two types of commandinterpreters will change the major mode of the Scheme process bufferto scheme-debugger-mode , in which the evaluation commands aredisabled, and the keys which normally self insert instead sendthemselves to the Scheme process.  The command character ? will listthe available commands.For older releases of Scheme, the major mode will be bescheme-interaction-mode , and the command characters must be sent asif 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-hookwith no args, if that value is non-nil."  (interactive)  (kill-all-local-variables)  (scheme-interaction-mode-initialize)  (scheme-mode-variables)  (make-local-variable 'xscheme-previous-send)  (run-hooks 'scheme-interaction-mode-hook))(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-previous-send))(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)))))(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 commandsare disabled, and characters that would normally be self inserting aresent to the Scheme process instead.  Typing ?  will show you whichcharacters 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))	  (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)	       (goto-char (point-max))	       (apply 'insert-before-markers strings)	       (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))))