annotate lisp/xscheme.el @ 35910:4e0463501485

Revert last change following loadup.el change.
author Dave Love <fx@gnu.org>
date Mon, 05 Feb 2001 17:41:40 +0000
parents 8af1f6c81e70
children 0715d86d229c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
29052
77868152457d Change header line.
Dave Love <fx@gnu.org>
parents: 21088
diff changeset
1 ;;; xscheme.el --- run MIT Scheme under Emacs
656
d74e65773062 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 258
diff changeset
2
840
113281b361ec *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 812
diff changeset
3 ;; Copyright (C) 1986, 1987, 1989, 1990 Free Software Foundation, Inc.
113281b361ec *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 812
diff changeset
4
773
9c89fd7ddd41 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 772
diff changeset
5 ;; Maintainer: FSF
5140
9cde7d7fea1f Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 5000
diff changeset
6 ;; Keywords: languages, lisp
772
2b5af16c9af3 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 656
diff changeset
7
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
9
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 773
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
13 ;; any later version.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
14
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
19
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14016
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14016
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14016
diff changeset
23 ;; Boston, MA 02111-1307, USA.
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
24
772
2b5af16c9af3 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 656
diff changeset
25 ;;; Commentary:
2b5af16c9af3 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 656
diff changeset
26
2319
d98c49df2acd Added or corrected Commentary section
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 851
diff changeset
27 ;; A major mode for editing Scheme and interacting with MIT's C-Scheme.
d98c49df2acd Added or corrected Commentary section
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 851
diff changeset
28 ;;
d98c49df2acd Added or corrected Commentary section
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 851
diff changeset
29 ;; Requires C-Scheme release 5 or later
d98c49df2acd Added or corrected Commentary section
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 851
diff changeset
30 ;; Changes to Control-G handler require runtime version 13.85 or later
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
31
772
2b5af16c9af3 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 656
diff changeset
32 ;;; Code:
2b5af16c9af3 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 656
diff changeset
33
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
34 (require 'scheme)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
35
21088
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
36 (defgroup xscheme nil
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
37 "Major mode for editing Scheme and interacting with MIT's C-Scheme."
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
38 :group 'lisp)
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
39
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
40 (defcustom scheme-band-name nil
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
41 "*Band loaded by the `run-scheme' command."
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
42 :type '(choice (const nil) string)
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
43 :group 'xscheme)
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
44
21088
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
45 (defcustom scheme-program-arguments nil
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
46 "*Arguments passed to the Scheme program by the `run-scheme' command."
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
47 :type '(choice (const nil) string)
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
48 :group 'xscheme)
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
49
21088
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
50 (defcustom xscheme-allow-pipelined-evaluation t
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
51 "If non-nil, an expression may be transmitted while another is evaluating.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
52 Otherwise, attempting to evaluate an expression before the previous expression
21088
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
53 has finished evaluating will signal an error."
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
54 :type 'boolean
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
55 :group 'xscheme)
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
56
21088
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
57 (defcustom xscheme-startup-message
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
58 "This is the Scheme process buffer.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
59 Type \\[advertised-xscheme-send-previous-expression] to evaluate the expression before point.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
60 Type \\[xscheme-send-control-g-interrupt] to abort evaluation.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
61 Type \\[describe-mode] for more information.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
62
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
63 "
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
64 "String to insert into Scheme process buffer first time it is started.
21088
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
65 Is processed with `substitute-command-keys' first."
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
66 :type 'string
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
67 :group 'xscheme)
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
68
21088
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
69 (defcustom xscheme-signal-death-message nil
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
70 "If non-nil, causes a message to be generated when the Scheme process dies."
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
71 :type 'boolean
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
72 :group 'xscheme)
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
73
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
74 (defun xscheme-evaluation-commands (keymap)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
75 (define-key keymap "\e\C-x" 'xscheme-send-definition)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
76 (define-key keymap "\C-x\C-e" 'advertised-xscheme-send-previous-expression)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
77 (define-key keymap "\eo" 'xscheme-send-buffer)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
78 (define-key keymap "\ez" 'xscheme-send-definition)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
79 (define-key keymap "\e\C-m" 'xscheme-send-previous-expression)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
80 (define-key keymap "\e\C-z" 'xscheme-send-region))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
81
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
82 (defun xscheme-interrupt-commands (keymap)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
83 (define-key keymap "\C-c\C-s" 'xscheme-select-process-buffer)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
84 (define-key keymap "\C-c\C-b" 'xscheme-send-breakpoint-interrupt)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
85 (define-key keymap "\C-c\C-c" 'xscheme-send-control-g-interrupt)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
86 (define-key keymap "\C-c\C-u" 'xscheme-send-control-u-interrupt)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
87 (define-key keymap "\C-c\C-x" 'xscheme-send-control-x-interrupt))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
88
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
89 (xscheme-evaluation-commands scheme-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
90 (xscheme-interrupt-commands scheme-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
92 (defun run-scheme (command-line)
9590
f84a7b49021d (run-scheme): Delete autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents: 5140
diff changeset
93 "Run MIT Scheme in an inferior process.
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
94 Output goes to the buffer `*scheme*'.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
95 With argument, asks for a command line."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
96 (interactive
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
97 (list (let ((default
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
98 (or xscheme-process-command-line
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
99 (xscheme-default-command-line))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
100 (if current-prefix-arg
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
101 (read-string "Run Scheme: " default)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
102 default))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
103 (setq xscheme-process-command-line command-line)
12866
4ce524de750f (run-scheme): Use pop-to-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 11565
diff changeset
104 (pop-to-buffer (xscheme-start-process command-line)))
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
105
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
106 (defun reset-scheme ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
107 "Reset the Scheme process."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
108 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
109 (let ((process (get-process "scheme")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
110 (cond ((or (not process)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
111 (not (eq (process-status process) 'run))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
112 (yes-or-no-p
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
113 "The Scheme process is running, are you SURE you want to reset it? "))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
114 (message "Resetting Scheme process...")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
115 (if process (kill-process process t))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
116 (xscheme-start-process xscheme-process-command-line)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
117 (message "Resetting Scheme process...done")))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
118
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
119 (defun xscheme-default-command-line ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
120 (concat scheme-program-name " -emacs"
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
121 (if scheme-program-arguments
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
122 (concat " " scheme-program-arguments)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
123 "")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
124 (if scheme-band-name
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
125 (concat " -band " scheme-band-name)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
126 "")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
127
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
128 ;;;; Interaction Mode
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
129
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
130 (defun scheme-interaction-mode ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
131 "Major mode for interacting with the inferior Scheme process.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
132 Like scheme-mode except that:
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
133
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
134 \\[advertised-xscheme-send-previous-expression] sends the expression before point to the Scheme process as input
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
135 \\[xscheme-yank-previous-send] yanks the expression most recently sent to Scheme
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
136
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
137 All output from the Scheme process is written in the Scheme process
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
138 buffer, which is initially named \"*scheme*\". The result of
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
139 evaluating a Scheme expression is also printed in the process buffer,
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
140 preceded by the string \";Value: \" to highlight it. If the process
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
141 buffer is not visible at that time, the value will also be displayed
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
142 in the minibuffer. If an error occurs, the process buffer will
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
143 automatically pop up to show you the error message.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
144
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
145 While the Scheme process is running, the modelines of all buffers in
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
146 scheme-mode are modified to show the state of the process. The
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
147 possible states and their meanings are:
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
148
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
149 input waiting for input
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
150 run evaluating
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
151 gc garbage collecting
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
152
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
153 The process buffer's modeline contains additional information where
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
154 the buffer's name is normally displayed: the command interpreter level
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
155 and type.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
156
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
157 Scheme maintains a stack of command interpreters. Every time an error
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
158 or breakpoint occurs, the current command interpreter is pushed on the
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
159 command interpreter stack, and a new command interpreter is started.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
160 One example of why this is done is so that an error that occurs while
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
161 you are debugging another error will not destroy the state of the
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
162 initial error, allowing you to return to it after the second error has
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
163 been fixed.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
164
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
165 The command interpreter level indicates how many interpreters are in
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
166 the command interpreter stack. It is initially set to one, and it is
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
167 incremented every time that stack is pushed, and decremented every
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
168 time it is popped. The following commands are useful for manipulating
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
169 the command interpreter stack:
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
170
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
171 \\[xscheme-send-breakpoint-interrupt] pushes the stack once
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
172 \\[xscheme-send-control-u-interrupt] pops the stack once
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
173 \\[xscheme-send-control-g-interrupt] pops everything off
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
174 \\[xscheme-send-control-x-interrupt] aborts evaluation, doesn't affect stack
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
175
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
176 Some possible command interpreter types and their meanings are:
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
177
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
178 [Evaluator] read-eval-print loop for evaluating expressions
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
179 [Debugger] single character commands for debugging errors
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
180 [Where] single character commands for examining environments
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
181
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
182 Starting with release 6.2 of Scheme, the latter two types of command
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
183 interpreters will change the major mode of the Scheme process buffer
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
184 to scheme-debugger-mode , in which the evaluation commands are
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
185 disabled, and the keys which normally self insert instead send
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
186 themselves to the Scheme process. The command character ? will list
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
187 the available commands.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
188
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
189 For older releases of Scheme, the major mode will be be
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
190 scheme-interaction-mode , and the command characters must be sent as
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
191 if they were expressions.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
192
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
193 Commands:
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
194 Delete converts tabs to spaces as it moves back.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
195 Blank lines separate paragraphs. Semicolons start comments.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
196 \\{scheme-interaction-mode-map}
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
197
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
198 Entry to this mode calls the value of scheme-interaction-mode-hook
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
199 with no args, if that value is non-nil.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
200 Likewise with the value of scheme-mode-hook.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
201 scheme-interaction-mode-hook is called after scheme-mode-hook."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
202 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
203 (kill-all-local-variables)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
204 (scheme-interaction-mode-initialize)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
205 (scheme-mode-variables)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
206 (make-local-variable 'xscheme-previous-send)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
207 (run-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
208
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
209 (defun scheme-interaction-mode-initialize ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
210 (use-local-map scheme-interaction-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
211 (setq major-mode 'scheme-interaction-mode)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
212 (setq mode-name "Scheme Interaction"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
213
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
214 (defun scheme-interaction-mode-commands (keymap)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
215 (define-key keymap "\C-c\C-m" 'xscheme-send-current-line)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
216 (define-key keymap "\C-c\C-p" 'xscheme-send-proceed)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
217 (define-key keymap "\C-c\C-y" 'xscheme-yank-previous-send))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
218
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
219 (defvar scheme-interaction-mode-map nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
220 (if (not scheme-interaction-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
221 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
222 (setq scheme-interaction-mode-map (make-keymap))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
223 (scheme-mode-commands scheme-interaction-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
224 (xscheme-interrupt-commands scheme-interaction-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
225 (xscheme-evaluation-commands scheme-interaction-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
226 (scheme-interaction-mode-commands scheme-interaction-mode-map)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
227
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
228 (defun xscheme-enter-interaction-mode ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
229 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
230 (set-buffer (xscheme-process-buffer))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
231 (if (not (eq major-mode 'scheme-interaction-mode))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
232 (if (eq major-mode 'scheme-debugger-mode)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
233 (scheme-interaction-mode-initialize)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
234 (scheme-interaction-mode)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
235
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
236 (fset 'advertised-xscheme-send-previous-expression
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
237 'xscheme-send-previous-expression)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
238
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
239 ;;;; Debugger Mode
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
240
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
241 (defun scheme-debugger-mode ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
242 "Major mode for executing the Scheme debugger.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
243 Like scheme-mode except that the evaluation commands
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
244 are disabled, and characters that would normally be self inserting are
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
245 sent to the Scheme process instead. Typing ? will show you which
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
246 characters perform useful functions.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
247
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
248 Commands:
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
249 \\{scheme-debugger-mode-map}"
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
250 (error "Illegal entry to scheme-debugger-mode"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
251
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
252 (defun scheme-debugger-mode-initialize ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
253 (use-local-map scheme-debugger-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
254 (setq major-mode 'scheme-debugger-mode)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
255 (setq mode-name "Scheme Debugger"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
256
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
257 (defun scheme-debugger-mode-commands (keymap)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
258 (let ((char ? ))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
259 (while (< char 127)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
260 (define-key keymap (char-to-string char) 'scheme-debugger-self-insert)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
261 (setq char (1+ char)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
262
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
263 (defvar scheme-debugger-mode-map nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
264 (if (not scheme-debugger-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
265 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
266 (setq scheme-debugger-mode-map (make-keymap))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
267 (scheme-mode-commands scheme-debugger-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
268 (xscheme-interrupt-commands scheme-debugger-mode-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
269 (scheme-debugger-mode-commands scheme-debugger-mode-map)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
270
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
271 (defun scheme-debugger-self-insert ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
272 "Transmit this character to the Scheme process."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
273 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
274 (xscheme-send-char last-command-char))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
275
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
276 (defun xscheme-enter-debugger-mode (prompt-string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
277 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
278 (set-buffer (xscheme-process-buffer))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
279 (if (not (eq major-mode 'scheme-debugger-mode))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
280 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
281 (if (not (eq major-mode 'scheme-interaction-mode))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
282 (scheme-interaction-mode))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
283 (scheme-debugger-mode-initialize)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
284
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
285 (defun xscheme-debugger-mode-p ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
286 (let ((buffer (xscheme-process-buffer)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
287 (and buffer
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
288 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
289 (set-buffer buffer)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
290 (eq major-mode 'scheme-debugger-mode)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
291
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
292 ;;;; Evaluation Commands
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
293
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
294 (defun xscheme-send-string (&rest strings)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
295 "Send the string arguments to the Scheme process.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
296 The strings are concatenated and terminated by a newline."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
297 (cond ((not (xscheme-process-running-p))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
298 (if (yes-or-no-p "The Scheme process has died. Reset it? ")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
299 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
300 (reset-scheme)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
301 (xscheme-wait-for-process)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
302 (goto-char (point-max))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
303 (apply 'insert-before-markers strings)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
304 (xscheme-send-string-1 strings))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
305 ((xscheme-debugger-mode-p) (error "No sends allowed in debugger mode"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
306 ((and (not xscheme-allow-pipelined-evaluation)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
307 xscheme-running-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
308 (error "No sends allowed while Scheme running"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
309 (t (xscheme-send-string-1 strings))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
310
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
311 (defun xscheme-send-string-1 (strings)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
312 (let ((string (apply 'concat strings)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
313 (xscheme-send-string-2 string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
314 (if (eq major-mode 'scheme-interaction-mode)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
315 (setq xscheme-previous-send string))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
316
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
317 (defun xscheme-send-string-2 (string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
318 (let ((process (get-process "scheme")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
319 (send-string process (concat string "\n"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
320 (if (xscheme-process-buffer-current-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
321 (set-marker (process-mark process) (point)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
322
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
323 (defun xscheme-yank-previous-send ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
324 "Insert the most recent expression at point."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
325 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
326 (push-mark)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
327 (insert xscheme-previous-send))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
328
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
329 (defun xscheme-select-process-buffer ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
330 "Select the Scheme process buffer and move to its output point."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
331 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
332 (let ((process (or (get-process "scheme") (error "No scheme process"))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
333 (let ((buffer (or (process-buffer process) (error "No process buffer"))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
334 (let ((window (get-buffer-window buffer)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
335 (if window
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
336 (select-window window)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
337 (switch-to-buffer buffer))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
338 (goto-char (process-mark process))))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
339
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
340 (defun xscheme-send-region (start end)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
341 "Send the current region to the Scheme process.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
342 The region is sent terminated by a newline."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
343 (interactive "r")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
344 (if (xscheme-process-buffer-current-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
345 (progn (goto-char end)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
346 (set-marker (process-mark (get-process "scheme")) end)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
347 (xscheme-send-string (buffer-substring start end)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
348
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
349 (defun xscheme-send-definition ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
350 "Send the current definition to the Scheme process.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
351 If the current line begins with a non-whitespace character,
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
352 parse an expression from the beginning of the line and send that instead."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
353 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
354 (let ((start nil) (end nil))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
355 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
356 (end-of-defun)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
357 (setq end (point))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
358 (if (re-search-backward "^\\s(" nil t)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
359 (setq start (point))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
360 (error "Can't find definition")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
361 (xscheme-send-region start end)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
362
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
363 (defun xscheme-send-next-expression ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
364 "Send the expression to the right of `point' to the Scheme process."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
365 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
366 (let ((start (point)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
367 (xscheme-send-region start (save-excursion (forward-sexp) (point)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
368
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
369 (defun xscheme-send-previous-expression ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
370 "Send the expression to the left of `point' to the Scheme process."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
371 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
372 (let ((end (point)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
373 (xscheme-send-region (save-excursion (backward-sexp) (point)) end)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
374
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
375 (defun xscheme-send-current-line ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
376 "Send the current line to the Scheme process.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
377 Useful for working with debugging Scheme under adb."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
378 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
379 (let ((line
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
380 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
381 (beginning-of-line)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
382 (let ((start (point)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
383 (end-of-line)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
384 (buffer-substring start (point))))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
385 (end-of-line)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
386 (insert ?\n)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
387 (xscheme-send-string-2 line)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
388
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
389 (defun xscheme-send-buffer ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
390 "Send the current buffer to the Scheme process."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
391 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
392 (if (xscheme-process-buffer-current-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
393 (error "Not allowed to send this buffer's contents to Scheme"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
394 (xscheme-send-region (point-min) (point-max)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
395
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
396 (defun xscheme-send-char (char)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
397 "Prompt for a character and send it to the Scheme process."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
398 (interactive "cCharacter to send: ")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
399 (send-string "scheme" (char-to-string char)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
400
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
401 ;;;; Interrupts
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
402
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
403 (defun xscheme-send-breakpoint-interrupt ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
404 "Cause the Scheme process to enter a breakpoint."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
405 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
406 (xscheme-send-interrupt ?b nil))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
407
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
408 (defun xscheme-send-proceed ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
409 "Cause the Scheme process to proceed from a breakpoint."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
410 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
411 (send-string "scheme" "(proceed)\n"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
412
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
413 (defun xscheme-send-control-g-interrupt ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
414 "Cause the Scheme processor to halt and flush input.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
415 Control returns to the top level rep loop."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
416 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
417 (let ((inhibit-quit t))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
418 (cond ((not xscheme-control-g-synchronization-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
419 (interrupt-process "scheme"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
420 (xscheme-control-g-disabled-p
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
421 (message "Relax..."))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
422 (t
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
423 (setq xscheme-control-g-disabled-p t)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
424 (message "Sending C-G interrupt to Scheme...")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
425 (interrupt-process "scheme")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
426 (send-string "scheme" (char-to-string 0))))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
427
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
428 (defun xscheme-send-control-u-interrupt ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
429 "Cause the Scheme process to halt, returning to previous rep loop."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
430 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
431 (xscheme-send-interrupt ?u t))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
432
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
433 (defun xscheme-send-control-x-interrupt ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
434 "Cause the Scheme process to halt, returning to current rep loop."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
435 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
436 (xscheme-send-interrupt ?x t))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
437
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
438 ;;; This doesn't really work right -- Scheme just gobbles the first
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
439 ;;; character in the input. There is no way for us to guarantee that
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
440 ;;; the argument to this procedure is the first char unless we put
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
441 ;;; some kind of marker in the input stream.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
442
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
443 (defun xscheme-send-interrupt (char mark-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
444 "Send a ^A type interrupt to the Scheme process."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
445 (interactive "cInterrupt character to send: ")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
446 (quit-process "scheme")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
447 (send-string "scheme" (char-to-string char))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
448 (if (and mark-p xscheme-control-g-synchronization-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
449 (send-string "scheme" (char-to-string 0))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
450
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
451 ;;;; Internal Variables
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
452
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
453 (defvar xscheme-process-command-line nil
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
454 "Command used to start the most recent Scheme process.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
455
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
456 (defvar xscheme-previous-send ""
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
457 "Most recent expression transmitted to the Scheme process.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
458
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
459 (defvar xscheme-process-filter-state 'idle
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
460 "State of scheme process escape reader state machine:
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
461 idle waiting for an escape sequence
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
462 reading-type received an altmode but nothing else
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
463 reading-string reading prompt string")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
464
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
465 (defvar xscheme-running-p nil
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
466 "This variable, if nil, indicates that the scheme process is
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
467 waiting for input. Otherwise, it is busy evaluating something.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
468
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
469 (defconst xscheme-control-g-synchronization-p t
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
470 "If non-nil, insert markers in the scheme input stream to indicate when
14016
cc69bd626089 (xscheme-control-g-synchronization-p): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 12866
diff changeset
471 control-g interrupts were signaled. Do not allow more control-g's to be
cc69bd626089 (xscheme-control-g-synchronization-p): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 12866
diff changeset
472 signaled until the scheme process acknowledges receipt.")
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
473
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
474 (defvar xscheme-control-g-disabled-p nil
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
475 "This variable, if non-nil, indicates that a control-g is being processed
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
476 by the scheme process, so additional control-g's are to be ignored.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
477
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
478 (defvar xscheme-allow-output-p t
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
479 "This variable, if nil, prevents output from the scheme process
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
480 from being inserted into the process-buffer.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
481
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
482 (defvar xscheme-prompt ""
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
483 "The current scheme prompt string.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
484
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
485 (defvar xscheme-string-accumulator ""
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
486 "Accumulator for the string being received from the scheme process.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
487
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
488 (defvar xscheme-string-receiver nil
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
489 "Procedure to send the string argument from the scheme process.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
490
21088
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
491 (defcustom xscheme-start-hook nil
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
492 "If non-nil, a procedure to call when the Scheme process is started.
21088
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
493 When called, the current buffer will be the Scheme process-buffer."
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
494 :type 'hook
ac1673121774 Customized.
Stephen Eglen <stephen@gnu.org>
parents: 14169
diff changeset
495 :group 'xscheme)
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
496
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
497 (defvar xscheme-runlight-string nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
498 (defvar xscheme-mode-string nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
499 (defvar xscheme-filter-input nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
500
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
501 ;;;; Basic Process Control
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
502
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
503 (defun xscheme-start-process (command-line)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
504 (let ((buffer (get-buffer-create "*scheme*")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
505 (let ((process (get-buffer-process buffer)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
506 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
507 (set-buffer buffer)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
508 (if (and process (memq (process-status process) '(run stop)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
509 (set-marker (process-mark process) (point-max))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
510 (progn (if process (delete-process process))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
511 (goto-char (point-max))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
512 (scheme-interaction-mode)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
513 (if (bobp)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
514 (insert-before-markers
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
515 (substitute-command-keys xscheme-startup-message)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
516 (setq process
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
517 (let ((process-connection-type nil))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
518 (apply 'start-process
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
519 (cons "scheme"
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
520 (cons buffer
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
521 (xscheme-parse-command-line
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
522 command-line))))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
523 (set-marker (process-mark process) (point-max))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
524 (xscheme-process-filter-initialize t)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
525 (xscheme-modeline-initialize)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
526 (set-process-sentinel process 'xscheme-process-sentinel)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
527 (set-process-filter process 'xscheme-process-filter)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
528 (run-hooks 'xscheme-start-hook)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
529 buffer))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
530
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
531 (defun xscheme-parse-command-line (string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
532 (setq string (substitute-in-file-name string))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
533 (let ((start 0)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
534 (result '()))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
535 (while start
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
536 (let ((index (string-match "[ \t]" string start)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
537 (setq start
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
538 (cond ((not index)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
539 (setq result
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
540 (cons (substring string start)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
541 result))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
542 nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
543 ((= index start)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
544 (string-match "[^ \t]" string start))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
545 (t
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
546 (setq result
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
547 (cons (substring string start index)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
548 result))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
549 (1+ index))))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
550 (nreverse result)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
551
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
552 (defun xscheme-wait-for-process ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
553 (sleep-for 2)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
554 (while xscheme-running-p
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
555 (sleep-for 1)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
556
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
557 (defun xscheme-process-running-p ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
558 "True iff there is a Scheme process whose status is `run'."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
559 (let ((process (get-process "scheme")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
560 (and process
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
561 (eq (process-status process) 'run))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
562
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
563 (defun xscheme-process-buffer ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
564 (let ((process (get-process "scheme")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
565 (and process (process-buffer process))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
566
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
567 (defun xscheme-process-buffer-window ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
568 (let ((buffer (xscheme-process-buffer)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
569 (and buffer (get-buffer-window buffer))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
570
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
571 (defun xscheme-process-buffer-current-p ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
572 "True iff the current buffer is the Scheme process buffer."
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
573 (eq (xscheme-process-buffer) (current-buffer)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
574
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
575 ;;;; Process Filter
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
576
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
577 (defun xscheme-process-sentinel (proc reason)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
578 (xscheme-process-filter-initialize (eq reason 'run))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
579 (if (eq reason 'run)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
580 (xscheme-modeline-initialize)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
581 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
582 (setq scheme-mode-line-process "")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
583 (setq xscheme-mode-string "no process")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
584 (if (and (not (memq reason '(run stop)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
585 xscheme-signal-death-message)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
586 (progn (beep)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
587 (message
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
588 "The Scheme process has died! Do M-x reset-scheme to restart it"))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
589
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
590 (defun xscheme-process-filter-initialize (running-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
591 (setq xscheme-process-filter-state 'idle)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
592 (setq xscheme-running-p running-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
593 (setq xscheme-control-g-disabled-p nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
594 (setq xscheme-allow-output-p t)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
595 (setq xscheme-prompt "")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
596 (setq scheme-mode-line-process '(": " xscheme-runlight-string)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
597
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
598 (defun xscheme-process-filter (proc string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
599 (let ((xscheme-filter-input string))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
600 (while xscheme-filter-input
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
601 (cond ((eq xscheme-process-filter-state 'idle)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
602 (let ((start (string-match "\e" xscheme-filter-input)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
603 (if start
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
604 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
605 (xscheme-process-filter-output
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
606 (substring xscheme-filter-input 0 start))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
607 (setq xscheme-filter-input
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
608 (substring xscheme-filter-input (1+ start)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
609 (setq xscheme-process-filter-state 'reading-type))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
610 (let ((string xscheme-filter-input))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
611 (setq xscheme-filter-input nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
612 (xscheme-process-filter-output string)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
613 ((eq xscheme-process-filter-state 'reading-type)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
614 (if (zerop (length xscheme-filter-input))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
615 (setq xscheme-filter-input nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
616 (let ((char (aref xscheme-filter-input 0)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
617 (setq xscheme-filter-input
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
618 (substring xscheme-filter-input 1))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
619 (let ((entry (assoc char xscheme-process-filter-alist)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
620 (if entry
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
621 (funcall (nth 2 entry) (nth 1 entry))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
622 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
623 (xscheme-process-filter-output ?\e char)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
624 (setq xscheme-process-filter-state 'idle)))))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
625 ((eq xscheme-process-filter-state 'reading-string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
626 (let ((start (string-match "\e" xscheme-filter-input)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
627 (if start
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
628 (let ((string
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
629 (concat xscheme-string-accumulator
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
630 (substring xscheme-filter-input 0 start))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
631 (setq xscheme-filter-input
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
632 (substring xscheme-filter-input (1+ start)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
633 (setq xscheme-process-filter-state 'idle)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
634 (funcall xscheme-string-receiver string))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
635 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
636 (setq xscheme-string-accumulator
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
637 (concat xscheme-string-accumulator
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
638 xscheme-filter-input))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
639 (setq xscheme-filter-input nil)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
640 (t
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
641 (error "Scheme process filter -- bad state"))))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
642
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
643 ;;;; Process Filter Output
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
644
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
645 (defun xscheme-process-filter-output (&rest args)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
646 (if xscheme-allow-output-p
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
647 (let ((string (apply 'concat args)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
648 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
649 (xscheme-goto-output-point)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
650 (while (string-match "\\(\007\\|\f\\)" string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
651 (let ((start (match-beginning 0))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
652 (end (match-end 0)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
653 (insert-before-markers (substring string 0 start))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
654 (if (= ?\f (aref string start))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
655 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
656 (if (not (bolp))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
657 (insert-before-markers ?\n))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
658 (insert-before-markers ?\f))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
659 (beep))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
660 (setq string (substring string (1+ start)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
661 (insert-before-markers string)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
662
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
663 (defun xscheme-guarantee-newlines (n)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
664 (if xscheme-allow-output-p
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
665 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
666 (xscheme-goto-output-point)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
667 (let ((stop nil))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
668 (while (and (not stop)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
669 (bolp))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
670 (setq n (1- n))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
671 (if (bobp)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
672 (setq stop t)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
673 (backward-char))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
674 (xscheme-goto-output-point)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
675 (while (> n 0)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
676 (insert-before-markers ?\n)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
677 (setq n (1- n))))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
678
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
679 (defun xscheme-goto-output-point ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
680 (let ((process (get-process "scheme")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
681 (set-buffer (process-buffer process))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
682 (goto-char (process-mark process))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
683
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
684 (defun xscheme-modeline-initialize ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
685 (setq xscheme-runlight-string "")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
686 (setq xscheme-mode-string "")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
687 (setq mode-line-buffer-identification '("Scheme: " xscheme-mode-string)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
688
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
689 (defun xscheme-set-runlight (runlight)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
690 (setq xscheme-runlight-string runlight)
11565
61cdc55737fb (xscheme-set-runlight, xscheme-set-prompt): Use force-mode-line-update.
Karl Heuer <kwzh@gnu.org>
parents: 9590
diff changeset
691 (force-mode-line-update t))
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
692
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
693 ;;;; Process Filter Operations
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
694
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
695 (defvar xscheme-process-filter-alist
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
696 '((?D xscheme-enter-debugger-mode
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
697 xscheme-process-filter:string-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
698 (?E xscheme-eval
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
699 xscheme-process-filter:string-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
700 (?P xscheme-set-prompt-variable
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
701 xscheme-process-filter:string-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
702 (?R xscheme-enter-interaction-mode
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
703 xscheme-process-filter:simple-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
704 (?b xscheme-start-gc
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
705 xscheme-process-filter:simple-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
706 (?e xscheme-finish-gc
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
707 xscheme-process-filter:simple-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
708 (?f xscheme-exit-input-wait
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
709 xscheme-process-filter:simple-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
710 (?g xscheme-enable-control-g
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
711 xscheme-process-filter:simple-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
712 (?i xscheme-prompt-for-expression
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
713 xscheme-process-filter:string-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
714 (?m xscheme-message
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
715 xscheme-process-filter:string-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
716 (?n xscheme-prompt-for-confirmation
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
717 xscheme-process-filter:string-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
718 (?o xscheme-output-goto
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
719 xscheme-process-filter:simple-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
720 (?p xscheme-set-prompt
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
721 xscheme-process-filter:string-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
722 (?s xscheme-enter-input-wait
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
723 xscheme-process-filter:simple-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
724 (?v xscheme-write-value
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
725 xscheme-process-filter:string-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
726 (?w xscheme-cd
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
727 xscheme-process-filter:string-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
728 (?z xscheme-display-process-buffer
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
729 xscheme-process-filter:simple-action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
730 (?c xscheme-unsolicited-read-char
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
731 xscheme-process-filter:simple-action))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
732 "Table used to decide how to handle process filter commands.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
733 Value is a list of entries, each entry is a list of three items.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
734
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
735 The first item is the character that the process filter dispatches on.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
736 The second item is the action to be taken, a function.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
737 The third item is the handler for the entry, a function.
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
738
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
739 When the process filter sees a command whose character matches a
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
740 particular entry, it calls the handler with two arguments: the action
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
741 and the string containing the rest of the process filter's input
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
742 stream. It is the responsibility of the handler to invoke the action
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
743 with the appropriate arguments, and to reenter the process filter with
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
744 the remaining input.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
745
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
746 (defun xscheme-process-filter:simple-action (action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
747 (setq xscheme-process-filter-state 'idle)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
748 (funcall action))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
749
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
750 (defun xscheme-process-filter:string-action (action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
751 (setq xscheme-string-receiver action)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
752 (setq xscheme-string-accumulator "")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
753 (setq xscheme-process-filter-state 'reading-string))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
754
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
755 (defconst xscheme-runlight:running "run"
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
756 "The character displayed when the Scheme process is running.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
757
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
758 (defconst xscheme-runlight:input "input"
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
759 "The character displayed when the Scheme process is waiting for input.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
760
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
761 (defconst xscheme-runlight:gc "gc"
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
762 "The character displayed when the Scheme process is garbage collecting.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
763
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
764 (defun xscheme-start-gc ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
765 (xscheme-set-runlight xscheme-runlight:gc))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
766
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
767 (defun xscheme-finish-gc ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
768 (xscheme-set-runlight
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
769 (if xscheme-running-p xscheme-runlight:running xscheme-runlight:input)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
770
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
771 (defun xscheme-enter-input-wait ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
772 (xscheme-set-runlight xscheme-runlight:input)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
773 (setq xscheme-running-p nil))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
774
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
775 (defun xscheme-exit-input-wait ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
776 (xscheme-set-runlight xscheme-runlight:running)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
777 (setq xscheme-running-p t))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
778
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
779 (defun xscheme-enable-control-g ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
780 (setq xscheme-control-g-disabled-p nil))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
781
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
782 (defun xscheme-display-process-buffer ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
783 (let ((window (or (xscheme-process-buffer-window)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
784 (display-buffer (xscheme-process-buffer)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
785 (save-window-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
786 (select-window window)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
787 (xscheme-goto-output-point)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
788 (if (xscheme-debugger-mode-p)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
789 (xscheme-enter-interaction-mode)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
790
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
791 (defun xscheme-unsolicited-read-char ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
792 nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
793
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
794 (defun xscheme-eval (string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
795 (eval (car (read-from-string string))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
796
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
797 (defun xscheme-message (string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
798 (if (not (zerop (length string)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
799 (xscheme-write-message-1 string (format ";%s" string))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
800
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
801 (defun xscheme-write-value (string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
802 (if (zerop (length string))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
803 (xscheme-write-message-1 "(no value)" ";No value")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
804 (xscheme-write-message-1 string (format ";Value: %s" string))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
805
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
806 (defun xscheme-write-message-1 (message-string output-string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
807 (let* ((process (get-process "scheme"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
808 (window (get-buffer-window (process-buffer process))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
809 (if (or (not window)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
810 (not (pos-visible-in-window-p (process-mark process)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
811 window)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
812 (message "%s" message-string)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
813 (xscheme-guarantee-newlines 1)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
814 (xscheme-process-filter-output output-string))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
815
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
816 (defun xscheme-set-prompt-variable (string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
817 (setq xscheme-prompt string))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
818
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
819 (defun xscheme-set-prompt (string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
820 (setq xscheme-prompt string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
821 (xscheme-guarantee-newlines 2)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
822 (setq xscheme-mode-string (xscheme-coerce-prompt string))
11565
61cdc55737fb (xscheme-set-runlight, xscheme-set-prompt): Use force-mode-line-update.
Karl Heuer <kwzh@gnu.org>
parents: 9590
diff changeset
823 (force-mode-line-update t))
91
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
824
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
825 (defun xscheme-output-goto ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
826 (xscheme-goto-output-point)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
827 (xscheme-guarantee-newlines 2))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
828
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
829 (defun xscheme-coerce-prompt (string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
830 (if (string-match "^[0-9]+ " string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
831 (let ((end (match-end 0)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
832 (concat (substring string 0 end)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
833 (let ((prompt (substring string end)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
834 (let ((entry (assoc prompt xscheme-prompt-alist)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
835 (if entry
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
836 (cdr entry)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
837 prompt)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
838 string))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
839
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
840 (defvar xscheme-prompt-alist
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
841 '(("[Normal REPL]" . "[Evaluator]")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
842 ("[Error REPL]" . "[Evaluator]")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
843 ("[Breakpoint REPL]" . "[Evaluator]")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
844 ("[Debugger REPL]" . "[Evaluator]")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
845 ("[Visiting environment]" . "[Evaluator]")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
846 ("[Environment Inspector]" . "[Where]"))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
847 "An alist which maps the Scheme command interpreter type to a print string.")
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
848
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
849 (defun xscheme-cd (directory-string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
850 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
851 (set-buffer (xscheme-process-buffer))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
852 (cd directory-string)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
853
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
854 (defun xscheme-prompt-for-confirmation (prompt-string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
855 (xscheme-send-char (if (y-or-n-p prompt-string) ?y ?n)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
856
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
857 (defun xscheme-prompt-for-expression (prompt-string)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
858 (xscheme-send-string-2
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
859 (read-from-minibuffer prompt-string nil xscheme-prompt-for-expression-map)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
860
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
861 (defvar xscheme-prompt-for-expression-map nil)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
862 (if (not xscheme-prompt-for-expression-map)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
863 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
864 (setq xscheme-prompt-for-expression-map
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
865 (copy-keymap minibuffer-local-map))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
866 (substitute-key-definition 'exit-minibuffer
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
867 'xscheme-prompt-for-expression-exit
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
868 xscheme-prompt-for-expression-map)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
869
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
870 (defun xscheme-prompt-for-expression-exit ()
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
871 (interactive)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
872 (if (eq (xscheme-region-expression-p (point-min) (point-max)) 'one)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
873 (exit-minibuffer)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
874 (error "input must be a single, complete expression")))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
875
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
876 (defun xscheme-region-expression-p (start end)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
877 (save-excursion
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
878 (let ((old-syntax-table (syntax-table)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
879 (unwind-protect
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
880 (progn
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
881 (set-syntax-table scheme-mode-syntax-table)
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
882 (let ((state (parse-partial-sexp start end)))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
883 (and (zerop (car state)) ;depth = 0
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
884 (nth 2 state) ;last-sexp exists, i.e. >= 1 sexps
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
885 (let ((state (parse-partial-sexp start (nth 2 state))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
886 (if (nth 2 state) 'many 'one)))))
d805392d61e7 Initial revision
Chris Hanson <cph@gnu.org>
parents:
diff changeset
887 (set-syntax-table old-syntax-table)))))
656
d74e65773062 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 258
diff changeset
888
5000
719f0190c04a Add a provide call.
Richard M. Stallman <rms@gnu.org>
parents: 2319
diff changeset
889 (provide 'xscheme)
719f0190c04a Add a provide call.
Richard M. Stallman <rms@gnu.org>
parents: 2319
diff changeset
890
656
d74e65773062 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 258
diff changeset
891 ;;; xscheme.el ends here