;;; Requires C-Scheme release 5 or later
;;; Changes to Control-G handler require runtime version 13.85 or later
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/etc/xscheme.el,v 1.9 1987/12/07 04:47:23 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/etc/xscheme.el,v 1.10 1987/12/07 09:42:13 cph Exp $
(require 'scheme)
\f
(defvar scheme-program-arguments nil
"*Arguments passed to the Scheme program by the `run-scheme' command.")
-(defvar xscheme-signal-death-message nil
- "If non-nil, causes a message to be generated when the Scheme process dies.")
-
(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 expression
has 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" '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)
+ (define-key keymap "\C-cn" 'xscheme-send-next-expression)
+ (define-key keymap "\C-cp" 'xscheme-send-previous-expression))
+
+(defun xscheme-interrupt-commands (keymap)
+ (define-key keymap "\C-cb" 'xscheme-send-breakpoint-interrupt)
+ (define-key keymap "\C-cg" 'xscheme-send-control-g-interrupt)
+ (define-key keymap "\C-cu" 'xscheme-send-control-u-interrupt)
+ (define-key keymap "\C-cx" 'xscheme-send-control-x-interrupt))
+
+(xscheme-evaluation-commands scheme-mode-map)
+(xscheme-interrupt-commands scheme-mode-map)
+\f
(defun run-scheme (command-line)
"Run an inferior Scheme process.
Output goes to the buffer `*scheme*'.
(concat " -band " scheme-band-name)
"")))
\f
-;;;; Internal Variables
-
-(defvar xscheme-process-command-line nil
- "Command used to start the most recent Scheme process.")
-
-(defvar xscheme-previous-send ""
- "Most recent expression transmitted to the Scheme process.")
-
-(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-process-filter-queue '()
- "Queue used to synchronize filter actions properly.")
-
-(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 (eq system-type 'hpux)
- "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.")
+;;;; 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 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:
+
+[Read-Eval-Print] Read-Eval-Print loop for evaluating expressions
+[Debugger] single character commands for debugging errors
+[Environment Inspector] single character commands for examining environments
+
+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. Typing ? will
+list the available commands.
+
+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."
+ (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-j" 'advertised-xscheme-send-previous-expression)
+ (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)))
-(defvar xscheme-prompt ""
- "The current scheme prompt string.")
+(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)))))
-(defvar xscheme-string-accumulator ""
- "Accumulator for the string being received from the scheme process.")
+(fset 'advertised-xscheme-send-previous-expression
+ 'xscheme-send-previous-expression)
+\f
+;;;; Debugger Mode
-(defvar xscheme-string-receiver nil
- "Procedure to send the string argument from the scheme process.")
+(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)))
-(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.")
+(defun scheme-debugger-self-insert ()
+ "Transmit this character to the Scheme process."
+ (interactive)
+ (xscheme-send-char last-command-char))
-(defvar xscheme-runlight-string nil)
-(defvar xscheme-mode-string nil)
-\f
-;;;; Keymaps
-
-(define-key scheme-mode-map "\eo" 'xscheme-send-buffer)
-(define-key scheme-mode-map "\ez" 'xscheme-send-definition)
-(define-key scheme-mode-map "\e\C-m" 'xscheme-send-previous-expression)
-(define-key scheme-mode-map "\e\C-x" 'xscheme-send-definition)
-(define-key scheme-mode-map "\e\C-z" 'xscheme-send-region)
-(define-key scheme-mode-map "\C-cn" 'xscheme-send-next-expression)
-(define-key scheme-mode-map "\C-cp" 'xscheme-send-previous-expression)
-;(define-key scheme-mode-map "\C-c\C-m" 'xscheme-send-current-line)
-(define-key scheme-mode-map "\C-c\C-y" 'xscheme-yank-previous-send)
-(define-key scheme-mode-map "\C-x\C-e" 'xscheme-send-previous-expression)
-(define-key scheme-mode-map "\C-cb" 'xscheme-send-breakpoint-interrupt)
-(define-key scheme-mode-map "\C-cg" 'xscheme-send-control-g-interrupt)
-(define-key scheme-mode-map "\C-cu" 'xscheme-send-control-u-interrupt)
-(define-key scheme-mode-map "\C-cx" 'xscheme-send-control-x-interrupt)
-
-(defun xscheme-make-shared-keymap (keymap)
- (let ((result (make-keymap)) (char 0))
- (while (< char 128)
- (aset result char (cons keymap char))
- (setq char (1+ char)))
- result))
-
-(defvar xscheme-mode-map nil)
-(if (not xscheme-mode-map)
- (progn
- (setq xscheme-mode-map (xscheme-make-shared-keymap scheme-mode-map))
- (define-key xscheme-mode-map "\C-j" 'xscheme-send-previous-expression)))
+(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)))))
-(defvar xscheme-debug-mode-map nil)
-(if (not xscheme-debug-mode-map)
- (progn
- (setq xscheme-debug-mode-map
- (xscheme-make-shared-keymap xscheme-mode-map))
- (let ((char ? ))
- (while (< char 127)
- (aset xscheme-debug-mode-map char 'xscheme-debug-self-insert)
- (setq char (1+ char))))))
+(defun xscheme-debugger-mode-p ()
+ (let ((buffer (xscheme-process-buffer)))
+ (and buffer
+ (save-excursion
+ (set-buffer buffer)
+ (eq major-mode 'scheme-debugger-mode)))))
\f
;;;; Evaluation Commands
(goto-char (point-max))
(apply 'insert-before-markers strings)
(xscheme-send-string-1 strings))))
- ((xscheme-debug-mode-p) (error "No sends allowed in debugger mode"))
+ ((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"))
(defun xscheme-send-string-1 (strings)
(let ((string (apply 'concat strings)))
(xscheme-send-string-2 string)
- (if (xscheme-process-buffer-current-p)
+ (if (eq major-mode 'scheme-interaction-mode)
(setq xscheme-previous-send string))))
(defun xscheme-send-string-2 (string)
(interactive)
(let ((end (point)))
(xscheme-send-region (save-excursion (backward-sexp) (point)) end)))
-
-(defun xscheme-eval-print-last-sexp ()
- "Send the expression to the left of `point' to the Scheme process.
-Works only in the Scheme process buffer."
- (interactive)
- (if (xscheme-process-buffer-current-p)
- (xscheme-send-previous-expression)
- (call-interactively 'newline-and-indent)))
\f
(defun xscheme-send-current-line ()
"Send the current line to the Scheme process.
(interactive)
(xscheme-send-interrupt ?b nil))
+(defun xscheme-send-proceed ()
+ "Cause the Scheme process to proceed from a breakpoint."
+ (interactive)
+ (send-string "scheme" "(proceed)\n"))
+
(defun xscheme-send-control-g-interrupt ()
"Cause the Scheme processor to halt and flush input.
Control returns to the top level rep loop."
(if (and mark-p xscheme-control-g-synchronization-p)
(send-string "scheme" (char-to-string 0))))
\f
+;;;; Internal Variables
+
+(defvar xscheme-process-command-line nil
+ "Command used to start the most recent Scheme process.")
+
+(defvar xscheme-previous-send ""
+ "Most recent expression transmitted to the Scheme process.")
+
+(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-process-filter-queue '()
+ "Queue used to synchronize filter actions properly.")
+
+(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 (eq system-type 'hpux)
+ "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-string nil)
+(defvar xscheme-mode-string nil)
+\f
;;;; Basic Process Control
(defun xscheme-start-process (command-line)
(set-marker (process-mark process) (point-max))
(progn (if process (delete-process process))
(goto-char (point-max))
- (scheme-mode xscheme-mode-map)
+ (if (bobp)
+ (insert-before-markers
+ (substitute-command-keys xscheme-startup-message)))
+ (scheme-interaction-mode)
(setq process
(apply 'start-process
(cons "scheme"
(xscheme-process-filter-initialize (eq reason 'run))
(if (eq reason 'run)
(xscheme-modeline-initialize)
- (setq scheme-mode-line-process "")))
+ (progn
+ (setq scheme-mode-line-process "")
+ (setq xscheme-mode-string "no process"))))
(if (and (not (memq reason '(run stop)))
xscheme-signal-death-message)
(progn (beep)
(setq xscheme-prompt "")
(setq xscheme-string-accumulator "")
(setq xscheme-string-receiver nil)
- (setq scheme-mode-line-process
- '(" " xscheme-runlight-string " " xscheme-mode-string)))
+ (setq scheme-mode-line-process '(": " xscheme-runlight-string)))
(defun xscheme-process-filter (proc string)
(let ((inhibit-quit t))
(goto-char (process-mark process))))
(defun xscheme-modeline-initialize ()
- (setq xscheme-runlight-string " ")
- (setq xscheme-mode-string ""))
+ (setq xscheme-runlight-string "")
+ (setq xscheme-mode-string "")
+ (setq mode-line-buffer-identification '("Scheme: " xscheme-mode-string)))
(defun xscheme-set-runlight (runlight)
- (aset xscheme-runlight-string 0 runlight)
+ (setq xscheme-runlight-string runlight)
(xscheme-modeline-redisplay))
(defun xscheme-modeline-redisplay ()
;;;; Process Filter Operations
(defvar xscheme-process-filter-alist
- '((?D xscheme-enter-debug-mode
+ '((?D xscheme-enter-debugger-mode
xscheme-process-filter:string-action)
(?P xscheme-set-prompt-variable
xscheme-process-filter:string-action)
- (?R xscheme-enter-rep-mode
+ (?R xscheme-enter-interaction-mode
xscheme-process-filter:simple-action)
(?b xscheme-start-gc
xscheme-process-filter:simple-action)
xscheme-process-filter:string-action)
(?n xscheme-prompt-for-confirmation
xscheme-process-filter:string-action)
- (?o xscheme-get-debug-command
+ (?o xscheme-output-goto
xscheme-process-filter:simple-action)
(?p xscheme-set-prompt
xscheme-process-filter:string-action)
(setq xscheme-string-receiver action)
(xscheme-process-filter:reading-string string))
-(defconst xscheme-runlight:running ?R
+(defconst xscheme-runlight:running "run"
"The character displayed when the Scheme process is running.")
-(defconst xscheme-runlight:input ?I
+(defconst xscheme-runlight:input "input"
"The character displayed when the Scheme process is waiting for input.")
-(defconst xscheme-runlight:gc ?G
+(defconst xscheme-runlight:gc "gc"
"The character displayed when the Scheme process is garbage collecting.")
(defun xscheme-start-gc ()
(save-window-excursion
(select-window window)
(xscheme-goto-output-point)
- (if (xscheme-debug-mode-p)
- (xscheme-enter-rep-mode)))))
+ (if (xscheme-debugger-mode-p)
+ (xscheme-enter-interaction-mode)))))
(defun xscheme-unsolicited-read-char ()
nil)
\f
-(defun xscheme-input-char-immediately ()
- (message "%s" xscheme-prompt)
- (let ((char nil)
- (aborted-p t)
- (not-done t))
- (unwind-protect
- (while not-done
- (setq char
- (let ((cursor-in-echo-area t))
- (read-char)))
- (cond ((= char ?\C-g)
- (setq char nil)
- (setq not-done nil))
- ((= char ?\n)
- ;; Disallow newlines, as Scheme is explicitly
- ;; ignoring them. This is necessary because
- ;; otherwise Scheme will attempt to read another
- ;; character.
- (beep))
- (t
- (setq aborted-p nil)
- (setq not-done nil))))
- (if aborted-p
- (xscheme-send-control-g-interrupt)))
- (message "")
- (if char
- (xscheme-send-char char))))
-
(defun xscheme-message (string)
(xscheme-write-message-1 nil string))
(if prefix
(format ";%s: %s" prefix string)
(format ";%s" string))))))
-\f
+
(defun xscheme-set-prompt-variable (string)
(setq xscheme-prompt string))
(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)))
(concat (substring string 0 end)
(let ((prompt (substring string end)))
- (cond ((or (string-equal prompt "]=>")
- (string-equal prompt "==>")
- (string-equal prompt "Eval-in-env-->"))
- "[Normal REP]")
- ((string-equal prompt "Bkpt->") "[Breakpoint REP]")
- ((string-equal prompt "Error->") "[Error REP]")
- ((string-equal prompt "Debug-->") "[Debugger]")
- ((string-equal prompt "Debugger-->") "[Debugger REP]")
- ((string-equal prompt "Where-->")
- "[Environment Inspector]")
- (t prompt)))))
+ (let ((entry (assoc prompt xscheme-prompt-alist)))
+ (if entry
+ (cdr entry)
+ prompt)))))
string))
-(defun add-to-global-mode-string (x)
- (cond ((null global-mode-string)
- (setq global-mode-string (list "" x " ")))
- ((not (memq x global-mode-string))
- (setq global-mode-string
- (cons ""
- (cons x
- (cons " "
- (if (equal "" (car global-mode-string))
- (cdr global-mode-string)
- global-mode-string))))))))
+(defvar xscheme-prompt-alist
+ '(("[Normal REPL]" . "[Read-Eval-Print]")
+ ("[Error REPL]" . "[Read-Eval-Print]")
+ ("[Breakpoint REPL]" . "[Read-Eval-Print]")
+ ("[Debugger REPL]" . "[Read-Eval-Print]")
+ ("[Visiting Environment]" . "[Read-Eval-Print]"))
+ "An alist which maps the Scheme command interpreter type to a print string.")
\f
-;;;; Debug Mode
-
-(defun xscheme-debug-mode ()
- "Major mode for executing the Scheme debugger.
-Just like `scheme-mode' except characters that would normally be self
-inserting are sent to Scheme instead.
-\\{xscheme-debug-mode-map}
-"
- (error "Illegal entry to xscheme-debug-mode"))
-
-(defun xscheme-enter-debug-mode (mode-string)
- (save-excursion
- (set-buffer (xscheme-process-buffer))
- (use-local-map xscheme-debug-mode-map)
- (setq major-mode 'xscheme-debug-mode)
- (setq mode-name mode-string)))
-
-(defun xscheme-debug-mode-p ()
- (let ((buffer (xscheme-process-buffer)))
- (and buffer
- (save-excursion
- (set-buffer buffer)
- (eq major-mode 'xscheme-debug-mode)))))
-
-(defun xscheme-debug-self-insert ()
- "Transmit this character to the Scheme process."
- (interactive)
- (xscheme-send-char last-command-char))
-
-(defun xscheme-get-debug-command ()
- (xscheme-goto-output-point)
- (xscheme-guarantee-newlines 2))
-\f
-(defun xscheme-enter-rep-mode ()
- (save-excursion
- (set-buffer (xscheme-process-buffer))
- (scheme-mode-initialize-internal xscheme-mode-map)))
-
(defun xscheme-prompt-for-confirmation (prompt-string)
(xscheme-send-char (if (y-or-n-p prompt-string) ?y ?n)))
projects / mit-scheme.git / commitdiff