From: Chris Hanson Date: Mon, 7 Dec 1987 09:42:13 +0000 (+0000) Subject: Improve documentation substantially. Add a message which is displayed X-Git-Tag: 20090517-FFI~13007 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=07700a9a09a32e2a8aa167c4c98dfa30290667b8;p=mit-scheme.git Improve documentation substantially. Add a message which is displayed at the start of the Scheme process to tell novices what to do. This can be disabled by setting it to the empty string. Change the handling of the keymaps so that they do not inherit. Implement a command to signal the interpreter to proceed from a breakpoint. Change the names of the major modes to be more systematic. --- diff --git a/etc/xscheme.el b/etc/xscheme.el index 3a76da6bb..341e5406e 100644 --- a/etc/xscheme.el +++ b/etc/xscheme.el @@ -21,7 +21,7 @@ ;;; 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) @@ -34,14 +34,43 @@ (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) + (defun run-scheme (command-line) "Run an inferior Scheme process. Output goes to the buffer `*scheme*'. @@ -78,95 +107,163 @@ With argument, asks for a command line." (concat " -band " scheme-band-name) ""))) -;;;; 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) + +;;;; 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) - -;;;; 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))))) ;;;; Evaluation Commands @@ -181,7 +278,7 @@ The strings are concatenated and terminated by a newline." (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")) @@ -190,7 +287,7 @@ The strings are concatenated and terminated by a newline." (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) @@ -239,14 +336,6 @@ parse an expression from the beginning of the line and send that instead." (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))) (defun xscheme-send-current-line () "Send the current line to the Scheme process. @@ -281,6 +370,11 @@ Useful for working with `adb'." (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." @@ -319,6 +413,56 @@ Control returns to the top level rep loop." (if (and mark-p xscheme-control-g-synchronization-p) (send-string "scheme" (char-to-string 0)))) +;;;; 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) + ;;;; Basic Process Control (defun xscheme-start-process (command-line) @@ -330,7 +474,10 @@ Control returns to the top level rep loop." (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" @@ -396,7 +543,9 @@ Control returns to the top level rep loop." (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) @@ -412,8 +561,7 @@ Control returns to the top level rep loop." (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)) @@ -524,11 +672,12 @@ Control returns to the top level rep loop." (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 () @@ -539,11 +688,11 @@ Control returns to the top level rep loop." ;;;; 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) @@ -559,7 +708,7 @@ Control returns to the top level rep loop." 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) @@ -601,13 +750,13 @@ the remaining input.") (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 () @@ -634,40 +783,12 @@ the remaining input.") (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) -(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)) @@ -687,7 +808,7 @@ the remaining input.") (if prefix (format ";%s: %s" prefix string) (format ";%s" string)))))) - + (defun xscheme-set-prompt-variable (string) (setq xscheme-prompt string)) @@ -697,74 +818,29 @@ the remaining input.") (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.") -;;;; 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)) - -(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)))