Mercurial > emacs

annotate lisp/xscheme.el @ 3781:6c05414356bc

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