Mercurial > emacs
annotate lisp/progmodes/xscheme.el @ 112392:70d7e5c6e611
calc/calc-prog.el
calc/calc-graph.el
calc/calc-map.el: Change `arglist' to `math-arglist' throughout.
author | Jay Belanger <jay.p.belanger@gmail.com> |
---|---|
date | Thu, 20 Jan 2011 21:48:26 -0600 |
parents | 417b1e4d63cd |
children |
rev | line source |
---|---|
50609 | 1 ;;; xscheme.el --- run MIT Scheme under Emacs |
2 | |
100908 | 3 ;; Copyright (C) 1986, 1987, 1989, 1990, 2001, 2002, 2003, 2004, 2005, |
112218
376148b31b5e
Add 2011 to FSF/AIST copyright years.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
4 ;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
50609 | 5 |
6 ;; Maintainer: FSF | |
7 ;; Keywords: languages, lisp | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
50609 | 12 ;; it under the terms of the GNU General Public License as published by |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
50609 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
50609 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;; A major mode for interacting with MIT Scheme. | |
27 ;; | |
28 ;; Requires MIT Scheme release 5 or later. | |
29 ;; Changes to Control-G handler require runtime version 13.85 or later. | |
30 | |
31 ;;; Code: | |
32 | |
33 (require 'scheme) | |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
34 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
35 ;;;; Internal Variables |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
36 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
37 (defvar xscheme-previous-mode) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
38 (defvar xscheme-previous-process-state) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
39 (defvar xscheme-last-input-end) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
40 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
41 (defvar xscheme-process-command-line nil |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
42 "Command used to start the most recent Scheme process.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
43 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
44 (defvar xscheme-process-name "scheme" |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
45 "Name of xscheme process that we're currently interacting with.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
46 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
47 (defvar xscheme-buffer-name "*scheme*" |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
48 "Name of xscheme buffer that we're currently interacting with.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
49 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
50 (defvar xscheme-expressions-ring-max 30 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
51 "*Maximum length of Scheme expressions ring.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
52 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
53 (defvar xscheme-expressions-ring nil |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
54 "List of expressions recently transmitted to the Scheme process.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
55 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
56 (defvar xscheme-expressions-ring-yank-pointer nil |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
57 "The tail of the Scheme expressions ring whose car is the last thing yanked.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
58 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
59 (defvar xscheme-running-p nil |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
60 "This variable, if nil, indicates that the scheme process is |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
61 waiting for input. Otherwise, it is busy evaluating something.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
62 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
63 (defconst xscheme-control-g-synchronization-p t |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
64 "If non-nil, insert markers in the scheme input stream to indicate when |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
65 control-g interrupts were signaled. Do not allow more control-g's to be |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
66 signaled until the scheme process acknowledges receipt.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
67 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
68 (defvar xscheme-control-g-disabled-p nil |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
69 "This variable, if non-nil, indicates that a control-g is being processed |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
70 by the scheme process, so additional control-g's are to be ignored.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
71 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
72 (defvar xscheme-string-receiver nil |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
73 "Procedure to send the string argument from the scheme process.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
74 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
75 (defconst default-xscheme-runlight |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
76 '(": " xscheme-runlight-string) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
77 "Default global (shared) xscheme-runlight modeline format.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
78 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
79 (defvar xscheme-runlight "") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
80 (defvar xscheme-runlight-string nil) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
81 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
82 (defvar xscheme-process-filter-state 'idle |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
83 "State of scheme process escape reader state machine: |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
84 idle waiting for an escape sequence |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
85 reading-type received an altmode but nothing else |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
86 reading-string reading prompt string") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
87 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
88 (defvar xscheme-allow-output-p t |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
89 "This variable, if nil, prevents output from the scheme process |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
90 from being inserted into the process-buffer.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
91 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
92 (defvar xscheme-prompt "" |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
93 "The current scheme prompt string.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
94 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
95 (defvar xscheme-string-accumulator "" |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
96 "Accumulator for the string being received from the scheme process.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
97 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
98 (defvar xscheme-mode-string nil) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
99 (setq-default scheme-mode-line-process |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
100 '("" xscheme-runlight)) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
101 |
84924
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
102 (mapc 'make-variable-buffer-local |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
103 '(xscheme-expressions-ring |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
104 xscheme-expressions-ring-yank-pointer |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
105 xscheme-process-filter-state |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
106 xscheme-running-p |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
107 xscheme-control-g-disabled-p |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
108 xscheme-allow-output-p |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
109 xscheme-prompt |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
110 xscheme-string-accumulator |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
111 xscheme-mode-string |
c3fb2ef00f90
(top): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78487
diff
changeset
|
112 scheme-mode-line-process)) |
50609 | 113 |
114 (defgroup xscheme nil | |
115 "Major mode for editing Scheme and interacting with MIT's C-Scheme." | |
116 :group 'lisp) | |
117 | |
118 (defcustom scheme-band-name nil | |
119 "*Band loaded by the `run-scheme' command." | |
120 :type '(choice (const nil) string) | |
121 :group 'xscheme) | |
122 | |
123 (defcustom scheme-program-arguments nil | |
124 "*Arguments passed to the Scheme program by the `run-scheme' command." | |
125 :type '(choice (const nil) string) | |
126 :group 'xscheme) | |
127 | |
128 (defcustom xscheme-allow-pipelined-evaluation t | |
129 "If non-nil, an expression may be transmitted while another is evaluating. | |
130 Otherwise, attempting to evaluate an expression before the previous expression | |
131 has finished evaluating will signal an error." | |
132 :type 'boolean | |
133 :group 'xscheme) | |
134 | |
135 (defcustom xscheme-startup-message | |
136 "This is the Scheme process buffer. | |
104922
c603ee2aac17
* keymap.c (QCadvertised_binding): New constant.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101002
diff
changeset
|
137 Type \\[xscheme-send-previous-expression] to evaluate the expression before point. |
50609 | 138 Type \\[xscheme-send-control-g-interrupt] to abort evaluation. |
139 Type \\[describe-mode] for more information. | |
140 | |
141 " | |
142 "String to insert into Scheme process buffer first time it is started. | |
143 Is processed with `substitute-command-keys' first." | |
144 :type 'string | |
145 :group 'xscheme) | |
146 | |
147 (defcustom xscheme-signal-death-message nil | |
148 "If non-nil, causes a message to be generated when the Scheme process dies." | |
149 :type 'boolean | |
150 :group 'xscheme) | |
151 | |
152 (defcustom xscheme-start-hook nil | |
153 "If non-nil, a procedure to call when the Scheme process is started. | |
154 When called, the current buffer will be the Scheme process-buffer." | |
155 :type 'hook | |
156 :group 'xscheme | |
157 :version "20.3") | |
158 | |
159 (defun xscheme-evaluation-commands (keymap) | |
160 (define-key keymap "\e\C-x" 'xscheme-send-definition) | |
104922
c603ee2aac17
* keymap.c (QCadvertised_binding): New constant.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101002
diff
changeset
|
161 (define-key keymap "\C-x\C-e" 'xscheme-send-previous-expression) |
c603ee2aac17
* keymap.c (QCadvertised_binding): New constant.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101002
diff
changeset
|
162 (put 'xscheme-send-previous-expression :advertised-binding "\C-x\C-e") |
50609 | 163 (define-key keymap "\eo" 'xscheme-send-buffer) |
164 (define-key keymap "\ez" 'xscheme-send-definition) | |
165 (define-key keymap "\e\C-m" 'xscheme-send-previous-expression) | |
166 (define-key keymap "\e\C-z" 'xscheme-send-region)) | |
167 | |
168 (defun xscheme-interrupt-commands (keymap) | |
169 (define-key keymap "\C-c\C-s" 'xscheme-select-process-buffer) | |
170 (define-key keymap "\C-c\C-b" 'xscheme-send-breakpoint-interrupt) | |
171 (define-key keymap "\C-c\C-c" 'xscheme-send-control-g-interrupt) | |
172 (define-key keymap "\C-c\C-u" 'xscheme-send-control-u-interrupt) | |
173 (define-key keymap "\C-c\C-x" 'xscheme-send-control-x-interrupt)) | |
174 | |
175 (xscheme-evaluation-commands scheme-mode-map) | |
176 (xscheme-interrupt-commands scheme-mode-map) | |
177 | |
178 (defun run-scheme (command-line) | |
179 "Run MIT Scheme in an inferior process. | |
180 Output goes to the buffer `*scheme*'. | |
181 With argument, asks for a command line." | |
182 (interactive (list (xscheme-read-command-line current-prefix-arg))) | |
183 (xscheme-start command-line xscheme-process-name xscheme-buffer-name)) | |
184 | |
185 (defun xscheme-start (command-line process-name buffer-name) | |
186 (setq-default xscheme-process-command-line command-line) | |
187 (switch-to-buffer | |
188 (xscheme-start-process command-line process-name buffer-name)) | |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
189 (set (make-local-variable 'xscheme-process-command-line) command-line)) |
50609 | 190 |
191 (defun xscheme-read-command-line (arg) | |
192 (let ((default | |
193 (or xscheme-process-command-line | |
194 (xscheme-default-command-line)))) | |
195 (if arg | |
196 (read-string "Run Scheme: " default) | |
197 default))) | |
198 | |
199 (defun xscheme-default-command-line () | |
200 (concat scheme-program-name " -emacs" | |
201 (if scheme-program-arguments | |
202 (concat " " scheme-program-arguments) | |
203 "") | |
204 (if scheme-band-name | |
205 (concat " -band " scheme-band-name) | |
206 ""))) | |
207 | |
208 (defun reset-scheme () | |
209 "Reset the Scheme process." | |
210 (interactive) | |
211 (let ((process (get-process xscheme-process-name))) | |
212 (cond ((or (not process) | |
213 (not (eq (process-status process) 'run)) | |
214 (yes-or-no-p | |
215 "The Scheme process is running, are you SURE you want to reset it? ")) | |
216 (message "Resetting Scheme process...") | |
217 (if process | |
218 (progn | |
219 (kill-process process t) | |
220 (delete-process process))) | |
221 (xscheme-start-process xscheme-process-command-line | |
222 xscheme-process-name | |
223 xscheme-buffer-name) | |
224 (message "Resetting Scheme process...done"))))) | |
225 | |
226 ;;;; Multiple Scheme buffer management commands | |
227 | |
228 (defun start-scheme (buffer-name &optional globally) | |
229 "Choose a scheme interaction buffer, or create a new one." | |
230 ;; (interactive "BScheme interaction buffer: \nP") | |
231 (interactive | |
232 (list (read-buffer "Scheme interaction buffer: " | |
233 xscheme-buffer-name | |
234 nil) | |
235 current-prefix-arg)) | |
236 (let ((buffer (get-buffer-create buffer-name))) | |
237 (let ((process (get-buffer-process buffer))) | |
238 (if process | |
239 (switch-to-buffer buffer) | |
240 (if (or (not (buffer-file-name buffer)) | |
241 (yes-or-no-p (concat "Buffer " | |
242 (buffer-name buffer) | |
243 " contains file " | |
244 (buffer-file-name buffer) | |
245 "; start scheme in it? "))) | |
246 (progn | |
247 (xscheme-start (xscheme-read-command-line t) | |
248 buffer-name | |
249 buffer-name) | |
250 (if globally | |
251 (global-set-scheme-interaction-buffer buffer-name))) | |
252 (message "start-scheme aborted")))))) | |
253 | |
254 (fset 'select-scheme 'start-scheme) | |
255 | |
256 (defun global-set-scheme-interaction-buffer (buffer-name) | |
257 "Set the default scheme interaction buffer." | |
258 (interactive | |
259 (list (read-buffer "Scheme interaction buffer: " | |
260 xscheme-buffer-name | |
261 t))) | |
262 (let ((process-name (verify-xscheme-buffer buffer-name nil))) | |
263 (setq-default xscheme-buffer-name buffer-name) | |
264 (setq-default xscheme-process-name process-name) | |
265 (setq-default xscheme-runlight-string | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
266 (with-current-buffer buffer-name |
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
267 xscheme-runlight-string)) |
50609 | 268 (setq-default xscheme-runlight |
269 (if (eq (process-status process-name) 'run) | |
270 default-xscheme-runlight | |
271 "")))) | |
272 | |
273 (defun local-set-scheme-interaction-buffer (buffer-name) | |
274 "Set the scheme interaction buffer for the current buffer." | |
275 (interactive | |
276 (list (read-buffer "Scheme interaction buffer: " | |
277 xscheme-buffer-name | |
278 t))) | |
279 (let ((process-name (verify-xscheme-buffer buffer-name t))) | |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
280 (set (make-local-variable 'xscheme-buffer-name) buffer-name) |
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
281 (set (make-local-variable 'xscheme-process-name) process-name) |
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
282 (set (make-local-variable 'xscheme-runlight) |
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
283 (with-current-buffer buffer-name |
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
284 xscheme-runlight)))) |
50609 | 285 |
286 (defun local-clear-scheme-interaction-buffer () | |
287 "Make the current buffer use the default scheme interaction buffer." | |
288 (interactive) | |
289 (if (xscheme-process-buffer-current-p) | |
290 (error "Cannot change the interaction buffer of an interaction buffer")) | |
291 (kill-local-variable 'xscheme-buffer-name) | |
292 (kill-local-variable 'xscheme-process-name) | |
293 (kill-local-variable 'xscheme-runlight)) | |
294 | |
295 (defun verify-xscheme-buffer (buffer-name localp) | |
296 (if (and localp (xscheme-process-buffer-current-p)) | |
297 (error "Cannot change the interaction buffer of an interaction buffer")) | |
298 (let* ((buffer (get-buffer buffer-name)) | |
299 (process (and buffer (get-buffer-process buffer)))) | |
300 (cond ((not buffer) | |
53855
7ebb0f4b6c1f
(verify-xscheme-buffer): Fix format strings.
Andreas Schwab <schwab@suse.de>
parents:
52401
diff
changeset
|
301 (error "Buffer `%s' does not exist" buffer-name)) |
50609 | 302 ((not process) |
53855
7ebb0f4b6c1f
(verify-xscheme-buffer): Fix format strings.
Andreas Schwab <schwab@suse.de>
parents:
52401
diff
changeset
|
303 (error "Buffer `%s' is not a scheme interaction buffer" buffer-name)) |
50609 | 304 (t |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
305 (with-current-buffer buffer |
50609 | 306 (if (not (xscheme-process-buffer-current-p)) |
53855
7ebb0f4b6c1f
(verify-xscheme-buffer): Fix format strings.
Andreas Schwab <schwab@suse.de>
parents:
52401
diff
changeset
|
307 (error "Buffer `%s' is not a scheme interaction buffer" |
50609 | 308 buffer-name))) |
309 (process-name process))))) | |
310 | |
311 ;;;; Interaction Mode | |
312 | |
313 (defun scheme-interaction-mode (&optional preserve) | |
314 "Major mode for interacting with an inferior MIT Scheme process. | |
315 Like scheme-mode except that: | |
316 | |
104922
c603ee2aac17
* keymap.c (QCadvertised_binding): New constant.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101002
diff
changeset
|
317 \\[xscheme-send-previous-expression] sends the expression before point to the Scheme process as input |
50609 | 318 \\[xscheme-yank-pop] yanks an expression previously sent to Scheme |
319 \\[xscheme-yank-push] yanks an expression more recently sent to Scheme | |
320 | |
321 All output from the Scheme process is written in the Scheme process | |
322 buffer, which is initially named \"*scheme*\". The result of | |
323 evaluating a Scheme expression is also printed in the process buffer, | |
324 preceded by the string \";Value: \" to highlight it. If the process | |
325 buffer is not visible at that time, the value will also be displayed | |
326 in the minibuffer. If an error occurs, the process buffer will | |
327 automatically pop up to show you the error message. | |
328 | |
329 While the Scheme process is running, the modelines of all buffers in | |
330 scheme-mode are modified to show the state of the process. The | |
331 possible states and their meanings are: | |
332 | |
333 input waiting for input | |
334 run evaluating | |
335 gc garbage collecting | |
336 | |
337 The process buffer's modeline contains additional information where | |
338 the buffer's name is normally displayed: the command interpreter level | |
339 and type. | |
340 | |
341 Scheme maintains a stack of command interpreters. Every time an error | |
342 or breakpoint occurs, the current command interpreter is pushed on the | |
343 command interpreter stack, and a new command interpreter is started. | |
344 One example of why this is done is so that an error that occurs while | |
345 you are debugging another error will not destroy the state of the | |
346 initial error, allowing you to return to it after the second error has | |
347 been fixed. | |
348 | |
349 The command interpreter level indicates how many interpreters are in | |
350 the command interpreter stack. It is initially set to one, and it is | |
351 incremented every time that stack is pushed, and decremented every | |
352 time it is popped. The following commands are useful for manipulating | |
353 the command interpreter stack: | |
354 | |
355 \\[xscheme-send-breakpoint-interrupt] pushes the stack once | |
356 \\[xscheme-send-control-u-interrupt] pops the stack once | |
357 \\[xscheme-send-control-g-interrupt] pops everything off | |
358 \\[xscheme-send-control-x-interrupt] aborts evaluation, doesn't affect stack | |
359 | |
360 Some possible command interpreter types and their meanings are: | |
361 | |
362 \[Evaluator] read-eval-print loop for evaluating expressions | |
363 \[Debugger] single character commands for debugging errors | |
364 \[Where] single character commands for examining environments | |
365 | |
366 Starting with release 6.2 of Scheme, the latter two types of command | |
367 interpreters will change the major mode of the Scheme process buffer | |
368 to scheme-debugger-mode , in which the evaluation commands are | |
369 disabled, and the keys which normally self insert instead send | |
370 themselves to the Scheme process. The command character ? will list | |
371 the available commands. | |
372 | |
373 For older releases of Scheme, the major mode will be be | |
374 scheme-interaction-mode , and the command characters must be sent as | |
375 if they were expressions. | |
376 | |
377 Commands: | |
378 Delete converts tabs to spaces as it moves back. | |
379 Blank lines separate paragraphs. Semicolons start comments. | |
380 \\{scheme-interaction-mode-map} | |
381 | |
382 Entry to this mode calls the value of scheme-interaction-mode-hook | |
383 with no args, if that value is non-nil. | |
384 Likewise with the value of scheme-mode-hook. | |
385 scheme-interaction-mode-hook is called after scheme-mode-hook." | |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
386 ;; FIXME: Use define-derived-mode. |
50609 | 387 (interactive "P") |
388 (if (not preserve) | |
389 (let ((previous-mode major-mode)) | |
390 (kill-all-local-variables) | |
391 (make-local-variable 'xscheme-process-name) | |
392 (make-local-variable 'xscheme-previous-process-state) | |
393 (make-local-variable 'xscheme-runlight-string) | |
394 (make-local-variable 'xscheme-runlight) | |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
395 (set (make-local-variable 'xscheme-previous-mode) previous-mode) |
50609 | 396 (let ((buffer (current-buffer))) |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
397 (set (make-local-variable 'xscheme-buffer-name) (buffer-name buffer)) |
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
398 (set (make-local-variable 'xscheme-last-input-end) (make-marker)) |
50609 | 399 (let ((process (get-buffer-process buffer))) |
400 (if process | |
401 (progn | |
402 (setq xscheme-process-name (process-name process)) | |
403 (setq xscheme-previous-process-state | |
404 (cons (process-filter process) | |
405 (process-sentinel process))) | |
406 (xscheme-process-filter-initialize t) | |
407 (xscheme-modeline-initialize xscheme-buffer-name) | |
408 (set-process-sentinel process 'xscheme-process-sentinel) | |
409 (set-process-filter process 'xscheme-process-filter)) | |
410 (setq xscheme-previous-process-state (cons nil nil))))))) | |
411 (scheme-interaction-mode-initialize) | |
412 (scheme-mode-variables) | |
62772
f2892faa87d4
* progmodes/ada-mode.el (ada-mode):
Lute Kamstra <lute@gnu.org>
parents:
60917
diff
changeset
|
413 (run-mode-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook)) |
50609 | 414 |
415 (defun exit-scheme-interaction-mode () | |
416 "Take buffer out of scheme interaction mode" | |
417 (interactive) | |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
418 (if (not (derived-mode-p 'scheme-interaction-mode)) |
50609 | 419 (error "Buffer not in scheme interaction mode")) |
420 (let ((previous-state xscheme-previous-process-state)) | |
421 (funcall xscheme-previous-mode) | |
422 (let ((process (get-buffer-process (current-buffer)))) | |
423 (if process | |
424 (progn | |
425 (if (eq (process-filter process) 'xscheme-process-filter) | |
426 (set-process-filter process (car previous-state))) | |
427 (if (eq (process-sentinel process) 'xscheme-process-sentinel) | |
428 (set-process-sentinel process (cdr previous-state)))))))) | |
429 | |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
430 (defvar scheme-interaction-mode-commands-alist nil) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
431 (defvar scheme-interaction-mode-map nil) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
432 |
50609 | 433 (defun scheme-interaction-mode-initialize () |
434 (use-local-map scheme-interaction-mode-map) | |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
435 (setq major-mode 'scheme-interaction-mode) ;FIXME: Use define-derived-mode. |
50609 | 436 (setq mode-name "Scheme Interaction")) |
437 | |
438 (defun scheme-interaction-mode-commands (keymap) | |
439 (let ((entries scheme-interaction-mode-commands-alist)) | |
440 (while entries | |
441 (define-key keymap | |
442 (car (car entries)) | |
443 (car (cdr (car entries)))) | |
444 (setq entries (cdr entries))))) | |
445 | |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
446 ;; Initialize the command alist |
50609 | 447 (setq scheme-interaction-mode-commands-alist |
448 (append scheme-interaction-mode-commands-alist | |
449 '(("\C-c\C-m" xscheme-send-current-line) | |
450 ("\C-c\C-o" xscheme-delete-output) | |
451 ("\C-c\C-p" xscheme-send-proceed) | |
452 ("\C-c\C-y" xscheme-yank) | |
453 ("\ep" xscheme-yank-pop) | |
454 ("\en" xscheme-yank-push)))) | |
455 | |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
456 ;; Initialize the mode map |
50609 | 457 (if (not scheme-interaction-mode-map) |
458 (progn | |
459 (setq scheme-interaction-mode-map (make-keymap)) | |
460 (scheme-mode-commands scheme-interaction-mode-map) | |
461 (xscheme-interrupt-commands scheme-interaction-mode-map) | |
462 (xscheme-evaluation-commands scheme-interaction-mode-map) | |
463 (scheme-interaction-mode-commands scheme-interaction-mode-map))) | |
464 | |
465 (defun xscheme-enter-interaction-mode () | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
466 (with-current-buffer (xscheme-process-buffer) |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
467 (if (not (derived-mode-p 'scheme-interaction-mode)) |
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
468 (if (derived-mode-p 'scheme-debugger-mode) |
50609 | 469 (scheme-interaction-mode-initialize) |
470 (scheme-interaction-mode t))))) | |
471 | |
104922
c603ee2aac17
* keymap.c (QCadvertised_binding): New constant.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101002
diff
changeset
|
472 (define-obsolete-function-alias 'advertised-xscheme-send-previous-expression |
c603ee2aac17
* keymap.c (QCadvertised_binding): New constant.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101002
diff
changeset
|
473 'xscheme-send-previous-expression "23.2") |
50609 | 474 |
475 ;;;; Debugger Mode | |
476 | |
477 (defun scheme-debugger-mode () | |
478 "Major mode for executing the Scheme debugger. | |
479 Like scheme-mode except that the evaluation commands | |
480 are disabled, and characters that would normally be self inserting are | |
481 sent to the Scheme process instead. Typing ? will show you which | |
482 characters perform useful functions. | |
483 | |
484 Commands: | |
485 \\{scheme-debugger-mode-map}" | |
60917
87f9bb9d3718
* progmodes/ebnf-abn.el, progmodes/ebnf-bnf.el,
Werner LEMBERG <wl@gnu.org>
parents:
53855
diff
changeset
|
486 (error "Invalid entry to scheme-debugger-mode")) |
50609 | 487 |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
488 (defvar scheme-debugger-mode-map nil) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
489 |
50609 | 490 (defun scheme-debugger-mode-initialize () |
491 (use-local-map scheme-debugger-mode-map) | |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
492 (setq major-mode 'scheme-debugger-mode) ;FIXME: Use define-derived-mode. |
50609 | 493 (setq mode-name "Scheme Debugger")) |
494 | |
495 (defun scheme-debugger-mode-commands (keymap) | |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
496 (let ((char ?\s)) |
50609 | 497 (while (< char 127) |
498 (define-key keymap (char-to-string char) 'scheme-debugger-self-insert) | |
499 (setq char (1+ char))))) | |
500 | |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
501 ;; Initialize the debugger mode map |
50609 | 502 (if (not scheme-debugger-mode-map) |
503 (progn | |
504 (setq scheme-debugger-mode-map (make-keymap)) | |
505 (scheme-mode-commands scheme-debugger-mode-map) | |
506 (xscheme-interrupt-commands scheme-debugger-mode-map) | |
507 (scheme-debugger-mode-commands scheme-debugger-mode-map))) | |
508 | |
509 (defun scheme-debugger-self-insert () | |
510 "Transmit this character to the Scheme process." | |
511 (interactive) | |
101002
3b3c7e10cd97
Replace last-command-char with last-command-event.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
512 (xscheme-send-char last-command-event)) |
50609 | 513 |
514 (defun xscheme-enter-debugger-mode (prompt-string) | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
515 (with-current-buffer (xscheme-process-buffer) |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
516 (if (not (derived-mode-p 'scheme-debugger-mode)) |
50609 | 517 (progn |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
518 (if (not (derived-mode-p 'scheme-interaction-mode)) |
50609 | 519 (scheme-interaction-mode t)) |
520 (scheme-debugger-mode-initialize))))) | |
521 | |
522 (defun xscheme-debugger-mode-p () | |
523 (let ((buffer (xscheme-process-buffer))) | |
524 (and buffer | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
525 (with-current-buffer buffer |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
526 (derived-mode-p 'scheme-debugger-mode))))) |
50609 | 527 |
528 ;;;; Evaluation Commands | |
529 | |
530 (defun xscheme-send-string (&rest strings) | |
531 "Send the string arguments to the Scheme process. | |
532 The strings are concatenated and terminated by a newline." | |
533 (cond ((not (xscheme-process-running-p)) | |
534 (if (yes-or-no-p "The Scheme process has died. Reset it? ") | |
535 (progn | |
536 (reset-scheme) | |
537 (xscheme-wait-for-process) | |
538 (xscheme-send-string-1 strings)))) | |
539 ((xscheme-debugger-mode-p) (error "No sends allowed in debugger mode")) | |
540 ((and (not xscheme-allow-pipelined-evaluation) | |
541 xscheme-running-p) | |
542 (error "No sends allowed while Scheme running")) | |
543 (t (xscheme-send-string-1 strings)))) | |
544 | |
545 (defun xscheme-send-string-1 (strings) | |
546 (let ((string (apply 'concat strings))) | |
547 (xscheme-send-string-2 string) | |
111870
b47e85affa59
Derive from prog-mode, use derived-mode-p, and fix up various
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
111445
diff
changeset
|
548 (if (derived-mode-p 'scheme-interaction-mode) |
50609 | 549 (xscheme-insert-expression string)))) |
550 | |
551 (defun xscheme-send-string-2 (string) | |
552 (let ((process (get-process xscheme-process-name))) | |
553 (process-send-string process (concat string "\n")) | |
554 (if (xscheme-process-buffer-current-p) | |
555 (set-marker (process-mark process) (point))))) | |
556 | |
557 (defun xscheme-select-process-buffer () | |
558 "Select the Scheme process buffer and move to its output point." | |
559 (interactive) | |
560 (let ((process | |
561 (or (get-process xscheme-process-name) | |
562 (error "No scheme process")))) | |
563 (let ((buffer (or (process-buffer process) (error "No process buffer")))) | |
564 (let ((window (get-buffer-window buffer))) | |
565 (if window | |
566 (select-window window) | |
567 (switch-to-buffer buffer)) | |
568 (goto-char (process-mark process)))))) | |
569 | |
570 ;;;; Scheme expressions ring | |
571 | |
572 (defun xscheme-insert-expression (string) | |
70423
b021bec005d5
(xscheme-insert-expression): Use add-to-history.
Kim F. Storm <storm@cua.dk>
parents:
68773
diff
changeset
|
573 (setq xscheme-expressions-ring-yank-pointer |
b021bec005d5
(xscheme-insert-expression): Use add-to-history.
Kim F. Storm <storm@cua.dk>
parents:
68773
diff
changeset
|
574 (add-to-history 'xscheme-expressions-ring string |
b021bec005d5
(xscheme-insert-expression): Use add-to-history.
Kim F. Storm <storm@cua.dk>
parents:
68773
diff
changeset
|
575 xscheme-expressions-ring-max))) |
50609 | 576 |
577 (defun xscheme-rotate-yank-pointer (arg) | |
578 "Rotate the yanking point in the kill ring." | |
579 (interactive "p") | |
580 (let ((length (length xscheme-expressions-ring))) | |
581 (if (zerop length) | |
582 (error "Scheme expression ring is empty") | |
583 (setq xscheme-expressions-ring-yank-pointer | |
584 (let ((index | |
585 (% (+ arg | |
586 (- length | |
587 (length xscheme-expressions-ring-yank-pointer))) | |
588 length))) | |
589 (nthcdr (if (< index 0) | |
590 (+ index length) | |
591 index) | |
592 xscheme-expressions-ring)))))) | |
593 | |
594 (defun xscheme-yank (&optional arg) | |
595 "Insert the most recent expression at point. | |
596 With just C-U as argument, same but put point in front (and mark at end). | |
597 With argument n, reinsert the nth most recently sent expression. | |
598 See also the commands \\[xscheme-yank-pop] and \\[xscheme-yank-push]." | |
599 (interactive "*P") | |
600 (xscheme-rotate-yank-pointer (if (listp arg) 0 | |
601 (if (eq arg '-) -1 | |
602 (1- arg)))) | |
603 (push-mark (point)) | |
604 (insert (car xscheme-expressions-ring-yank-pointer)) | |
605 (if (consp arg) | |
606 (exchange-point-and-mark))) | |
607 | |
608 ;; Old name, to avoid errors in users' init files. | |
609 (fset 'xscheme-yank-previous-send | |
610 'xscheme-yank) | |
611 | |
612 (defun xscheme-yank-pop (arg) | |
613 "Insert or replace a just-yanked expression with an older expression. | |
614 If the previous command was not a yank, it yanks. | |
615 Otherwise, the region contains a stretch of reinserted | |
616 expression. yank-pop deletes that text and inserts in its | |
617 place a different expression. | |
618 | |
619 With no argument, the next older expression is inserted. | |
620 With argument n, the n'th older expression is inserted. | |
621 If n is negative, this is a more recent expression. | |
622 | |
623 The sequence of expressions wraps around, so that after the oldest one | |
624 comes the newest one." | |
625 (interactive "*p") | |
626 (setq this-command 'xscheme-yank) | |
627 (if (not (eq last-command 'xscheme-yank)) | |
628 (progn | |
629 (xscheme-yank) | |
630 (setq arg (- arg 1)))) | |
631 (if (not (= arg 0)) | |
632 (let ((before (< (point) (mark)))) | |
633 (delete-region (point) (mark)) | |
634 (xscheme-rotate-yank-pointer arg) | |
635 (set-mark (point)) | |
636 (insert (car xscheme-expressions-ring-yank-pointer)) | |
637 (if before (exchange-point-and-mark))))) | |
638 | |
639 (defun xscheme-yank-push (arg) | |
640 "Insert or replace a just-yanked expression with a more recent expression. | |
641 If the previous command was not a yank, it yanks. | |
642 Otherwise, the region contains a stretch of reinserted | |
643 expression. yank-pop deletes that text and inserts in its | |
644 place a different expression. | |
645 | |
646 With no argument, the next more recent expression is inserted. | |
647 With argument n, the n'th more recent expression is inserted. | |
648 If n is negative, a less recent expression is used. | |
649 | |
650 The sequence of expressions wraps around, so that after the oldest one | |
651 comes the newest one." | |
652 (interactive "*p") | |
653 (xscheme-yank-pop (- 0 arg))) | |
654 | |
655 (defun xscheme-send-region (start end) | |
656 "Send the current region to the Scheme process. | |
657 The region is sent terminated by a newline." | |
658 (interactive "r") | |
659 (if (xscheme-process-buffer-current-p) | |
660 (progn | |
661 (goto-char end) | |
662 (if (not (bolp)) | |
663 (insert-before-markers ?\n)) | |
664 (set-marker (process-mark (get-process xscheme-process-name)) | |
665 (point)) | |
666 (set-marker xscheme-last-input-end (point)))) | |
667 (xscheme-send-string (buffer-substring start end))) | |
668 | |
669 (defun xscheme-send-definition () | |
670 "Send the current definition to the Scheme process. | |
671 If the current line begins with a non-whitespace character, | |
672 parse an expression from the beginning of the line and send that instead." | |
673 (interactive) | |
674 (let ((start nil) (end nil)) | |
675 (save-excursion | |
676 (end-of-defun) | |
677 (setq end (point)) | |
678 (if (re-search-backward "^\\s(" nil t) | |
679 (setq start (point)) | |
680 (error "Can't find definition"))) | |
681 (xscheme-send-region start end))) | |
682 | |
683 (defun xscheme-send-next-expression () | |
684 "Send the expression to the right of `point' to the Scheme process." | |
685 (interactive) | |
686 (let ((start (point))) | |
687 (xscheme-send-region start (save-excursion (forward-sexp) (point))))) | |
688 | |
689 (defun xscheme-send-previous-expression () | |
690 "Send the expression to the left of `point' to the Scheme process." | |
691 (interactive) | |
692 (let ((end (point))) | |
693 (xscheme-send-region (save-excursion (backward-sexp) (point)) end))) | |
694 | |
695 (defun xscheme-send-current-line () | |
696 "Send the current line to the Scheme process. | |
697 Useful for working with debugging Scheme under adb." | |
698 (interactive) | |
111445
56b71cddc9c5
Replace still more end-of-line etc with line-end-position, etc.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
699 (let ((line (buffer-substring (line-beginning-position) (line-end-position)))) |
50609 | 700 (end-of-line) |
701 (insert ?\n) | |
702 (xscheme-send-string-2 line))) | |
703 | |
704 (defun xscheme-send-buffer () | |
705 "Send the current buffer to the Scheme process." | |
706 (interactive) | |
707 (if (xscheme-process-buffer-current-p) | |
708 (error "Not allowed to send this buffer's contents to Scheme")) | |
709 (xscheme-send-region (point-min) (point-max))) | |
710 | |
711 (defun xscheme-send-char (char) | |
712 "Prompt for a character and send it to the Scheme process." | |
713 (interactive "cCharacter to send: ") | |
714 (process-send-string xscheme-process-name (char-to-string char))) | |
715 | |
716 (defun xscheme-delete-output () | |
717 "Delete all output from interpreter since last input." | |
718 (interactive) | |
719 (let ((proc (get-buffer-process (current-buffer)))) | |
720 (save-excursion | |
721 (goto-char (process-mark proc)) | |
722 (re-search-backward | |
723 "^;\\(Unspecified return value$\\|Value\\( [0-9]+\\)?: \\|\\(Abort\\|Up\\|Quit\\)!$\\)" | |
724 xscheme-last-input-end | |
725 t) | |
726 (forward-line 0) | |
727 (if (< (marker-position xscheme-last-input-end) (point)) | |
728 (progn | |
729 (delete-region xscheme-last-input-end (point)) | |
730 (insert-before-markers "*** output flushed ***\n")))))) | |
731 | |
732 ;;;; Interrupts | |
733 | |
734 (defun xscheme-send-breakpoint-interrupt () | |
735 "Cause the Scheme process to enter a breakpoint." | |
736 (interactive) | |
737 (xscheme-send-interrupt ?b nil)) | |
738 | |
739 (defun xscheme-send-proceed () | |
740 "Cause the Scheme process to proceed from a breakpoint." | |
741 (interactive) | |
742 (process-send-string xscheme-process-name "(proceed)\n")) | |
743 | |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
744 (defconst xscheme-control-g-message-string |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
745 "Sending C-G interrupt to Scheme...") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
746 |
50609 | 747 (defun xscheme-send-control-g-interrupt () |
748 "Cause the Scheme processor to halt and flush input. | |
749 Control returns to the top level rep loop." | |
750 (interactive) | |
751 (let ((inhibit-quit t)) | |
752 (cond ((not xscheme-control-g-synchronization-p) | |
753 (interrupt-process xscheme-process-name)) | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
754 ((with-current-buffer xscheme-buffer-name |
50609 | 755 xscheme-control-g-disabled-p) |
756 (message "Relax...")) | |
757 (t | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
758 (with-current-buffer xscheme-buffer-name |
50609 | 759 (setq xscheme-control-g-disabled-p t)) |
760 (message xscheme-control-g-message-string) | |
761 (interrupt-process xscheme-process-name) | |
762 (sleep-for 0.1) | |
763 (xscheme-send-char 0))))) | |
764 | |
765 (defun xscheme-send-control-u-interrupt () | |
766 "Cause the Scheme process to halt, returning to previous rep loop." | |
767 (interactive) | |
768 (xscheme-send-interrupt ?u t)) | |
769 | |
770 (defun xscheme-send-control-x-interrupt () | |
771 "Cause the Scheme process to halt, returning to current rep loop." | |
772 (interactive) | |
773 (xscheme-send-interrupt ?x t)) | |
774 | |
775 ;;; This doesn't really work right -- Scheme just gobbles the first | |
776 ;;; character in the input. There is no way for us to guarantee that | |
777 ;;; the argument to this procedure is the first char unless we put | |
778 ;;; some kind of marker in the input stream. | |
779 | |
780 (defun xscheme-send-interrupt (char mark-p) | |
781 "Send a ^A type interrupt to the Scheme process." | |
782 (interactive "cInterrupt character to send: ") | |
783 (quit-process xscheme-process-name) | |
784 (sleep-for 0.1) | |
785 (xscheme-send-char char) | |
786 (if (and mark-p xscheme-control-g-synchronization-p) | |
787 (xscheme-send-char 0))) | |
788 | |
789 ;;;; Basic Process Control | |
790 | |
791 (defun xscheme-start-process (command-line the-process the-buffer) | |
792 (let ((buffer (get-buffer-create the-buffer))) | |
793 (let ((process (get-buffer-process buffer))) | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
794 (with-current-buffer buffer |
50609 | 795 (if (and process (memq (process-status process) '(run stop))) |
796 (set-marker (process-mark process) (point-max)) | |
797 (progn (if process (delete-process process)) | |
798 (goto-char (point-max)) | |
799 (scheme-interaction-mode nil) | |
800 (setq xscheme-process-name the-process) | |
801 (if (bobp) | |
802 (insert-before-markers | |
803 (substitute-command-keys xscheme-startup-message))) | |
804 (setq process | |
805 (let ((process-connection-type nil)) | |
806 (apply 'start-process | |
807 (cons the-process | |
808 (cons buffer | |
809 (xscheme-parse-command-line | |
810 command-line)))))) | |
811 (if (not (equal (process-name process) the-process)) | |
812 (setq xscheme-process-name (process-name process))) | |
813 (if (not (equal (buffer-name buffer) the-buffer)) | |
814 (setq xscheme-buffer-name (buffer-name buffer))) | |
815 (message "Starting process %s in buffer %s" | |
816 xscheme-process-name | |
817 xscheme-buffer-name) | |
818 (set-marker (process-mark process) (point-max)) | |
819 (xscheme-process-filter-initialize t) | |
820 (xscheme-modeline-initialize xscheme-buffer-name) | |
821 (set-process-sentinel process 'xscheme-process-sentinel) | |
822 (set-process-filter process 'xscheme-process-filter) | |
823 (run-hooks 'xscheme-start-hook))))) | |
824 buffer)) | |
825 | |
826 (defun xscheme-parse-command-line (string) | |
827 (setq string (substitute-in-file-name string)) | |
828 (let ((start 0) | |
829 (result '())) | |
830 (while start | |
831 (let ((index (string-match "[ \t]" string start))) | |
832 (setq start | |
833 (cond ((not index) | |
834 (setq result | |
835 (cons (substring string start) | |
836 result)) | |
837 nil) | |
838 ((= index start) | |
839 (string-match "[^ \t]" string start)) | |
840 (t | |
841 (setq result | |
842 (cons (substring string start index) | |
843 result)) | |
844 (1+ index)))))) | |
845 (nreverse result))) | |
846 | |
847 (defun xscheme-wait-for-process () | |
848 (sleep-for 2) | |
849 (while xscheme-running-p | |
850 (sleep-for 1))) | |
851 | |
852 (defun xscheme-process-running-p () | |
78487
419c5c316b51
Replace `iff' in doc-strings and comments.
Glenn Morris <rgm@gnu.org>
parents:
78234
diff
changeset
|
853 "True if there is a Scheme process whose status is `run'." |
50609 | 854 (let ((process (get-process xscheme-process-name))) |
855 (and process | |
856 (eq (process-status process) 'run)))) | |
857 | |
858 (defun xscheme-process-buffer () | |
859 (let ((process (get-process xscheme-process-name))) | |
860 (and process (process-buffer process)))) | |
861 | |
862 (defun xscheme-process-buffer-window () | |
863 (let ((buffer (xscheme-process-buffer))) | |
864 (and buffer (get-buffer-window buffer)))) | |
865 | |
866 (defun xscheme-process-buffer-current-p () | |
78487
419c5c316b51
Replace `iff' in doc-strings and comments.
Glenn Morris <rgm@gnu.org>
parents:
78234
diff
changeset
|
867 "True if the current buffer is the Scheme process buffer." |
50609 | 868 (eq (xscheme-process-buffer) (current-buffer))) |
869 | |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
870 ;;;; Process Filter Operations |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
871 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
872 (defvar xscheme-process-filter-alist |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
873 '((?A xscheme-eval |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
874 xscheme-process-filter:string-action-noexcursion) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
875 (?D xscheme-enter-debugger-mode |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
876 xscheme-process-filter:string-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
877 (?E xscheme-eval |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
878 xscheme-process-filter:string-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
879 (?P xscheme-set-prompt-variable |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
880 xscheme-process-filter:string-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
881 (?R xscheme-enter-interaction-mode |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
882 xscheme-process-filter:simple-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
883 (?b xscheme-start-gc |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
884 xscheme-process-filter:simple-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
885 (?c xscheme-unsolicited-read-char |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
886 xscheme-process-filter:simple-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
887 (?e xscheme-finish-gc |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
888 xscheme-process-filter:simple-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
889 (?f xscheme-exit-input-wait |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
890 xscheme-process-filter:simple-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
891 (?g xscheme-enable-control-g |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
892 xscheme-process-filter:simple-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
893 (?i xscheme-prompt-for-expression |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
894 xscheme-process-filter:string-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
895 (?m xscheme-message |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
896 xscheme-process-filter:string-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
897 (?n xscheme-prompt-for-confirmation |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
898 xscheme-process-filter:string-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
899 (?o xscheme-output-goto |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
900 xscheme-process-filter:simple-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
901 (?p xscheme-set-prompt |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
902 xscheme-process-filter:string-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
903 (?s xscheme-enter-input-wait |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
904 xscheme-process-filter:simple-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
905 (?v xscheme-write-value |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
906 xscheme-process-filter:string-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
907 (?w xscheme-cd |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
908 xscheme-process-filter:string-action) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
909 (?z xscheme-display-process-buffer |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
910 xscheme-process-filter:simple-action)) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
911 "Table used to decide how to handle process filter commands. |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
912 Value is a list of entries, each entry is a list of three items. |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
913 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
914 The first item is the character that the process filter dispatches on. |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
915 The second item is the action to be taken, a function. |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
916 The third item is the handler for the entry, a function. |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
917 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
918 When the process filter sees a command whose character matches a |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
919 particular entry, it calls the handler with two arguments: the action |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
920 and the string containing the rest of the process filter's input |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
921 stream. It is the responsibility of the handler to invoke the action |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
922 with the appropriate arguments, and to reenter the process filter with |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
923 the remaining input.") |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
924 |
50609 | 925 ;;;; Process Filter |
926 | |
927 (defun xscheme-process-sentinel (proc reason) | |
928 (let* ((buffer (process-buffer proc)) | |
929 (name (buffer-name buffer))) | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
930 (with-current-buffer buffer |
50609 | 931 (xscheme-process-filter-initialize (eq reason 'run)) |
932 (if (not (eq reason 'run)) | |
933 (progn | |
934 (setq scheme-mode-line-process "") | |
935 (setq xscheme-mode-string "no process") | |
936 (if (equal name (default-value 'xscheme-buffer-name)) | |
937 (setq-default xscheme-runlight "")))) | |
938 (if (and (not (memq reason '(run stop))) | |
939 xscheme-signal-death-message) | |
940 (progn | |
941 (beep) | |
942 (message | |
943 "The Scheme process has died! Do M-x reset-scheme to restart it")))))) | |
944 | |
945 (defun xscheme-process-filter-initialize (running-p) | |
946 (setq xscheme-process-filter-state 'idle) | |
947 (setq xscheme-running-p running-p) | |
948 (setq xscheme-control-g-disabled-p nil) | |
949 (setq xscheme-allow-output-p t) | |
950 (setq xscheme-prompt "") | |
951 (if running-p | |
952 (let ((name (buffer-name (current-buffer)))) | |
953 (setq scheme-mode-line-process '(": " xscheme-runlight-string)) | |
954 (xscheme-modeline-initialize name) | |
955 (if (equal name (default-value 'xscheme-buffer-name)) | |
956 (setq-default xscheme-runlight default-xscheme-runlight)))) | |
957 (if (or (eq xscheme-runlight default-xscheme-runlight) | |
958 (equal xscheme-runlight "")) | |
959 (setq xscheme-runlight (list ": " 'xscheme-buffer-name ": " "?"))) | |
960 (rplaca (nthcdr 3 xscheme-runlight) | |
961 (if running-p "?" "no process"))) | |
962 | |
963 (defun xscheme-process-filter (proc string) | |
964 (let ((xscheme-filter-input string) | |
965 (call-noexcursion nil)) | |
966 (while xscheme-filter-input | |
967 (setq call-noexcursion nil) | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
968 (with-current-buffer (process-buffer proc) |
50609 | 969 (cond ((eq xscheme-process-filter-state 'idle) |
970 (let ((start (string-match "\e" xscheme-filter-input))) | |
971 (if start | |
972 (progn | |
973 (xscheme-process-filter-output | |
974 (substring xscheme-filter-input 0 start)) | |
975 (setq xscheme-filter-input | |
976 (substring xscheme-filter-input (1+ start))) | |
977 (setq xscheme-process-filter-state 'reading-type)) | |
978 (let ((string xscheme-filter-input)) | |
979 (setq xscheme-filter-input nil) | |
980 (xscheme-process-filter-output string))))) | |
981 ((eq xscheme-process-filter-state 'reading-type) | |
982 (if (zerop (length xscheme-filter-input)) | |
983 (setq xscheme-filter-input nil) | |
984 (let ((char (aref xscheme-filter-input 0))) | |
985 (setq xscheme-filter-input | |
986 (substring xscheme-filter-input 1)) | |
987 (let ((entry (assoc char xscheme-process-filter-alist))) | |
988 (if entry | |
989 (funcall (nth 2 entry) (nth 1 entry)) | |
990 (progn | |
991 (xscheme-process-filter-output ?\e char) | |
992 (setq xscheme-process-filter-state 'idle))))))) | |
993 ((eq xscheme-process-filter-state 'reading-string) | |
994 (let ((start (string-match "\e" xscheme-filter-input))) | |
995 (if start | |
996 (let ((string | |
997 (concat xscheme-string-accumulator | |
998 (substring xscheme-filter-input 0 start)))) | |
999 (setq xscheme-filter-input | |
1000 (substring xscheme-filter-input (1+ start))) | |
1001 (setq xscheme-process-filter-state 'idle) | |
1002 (if (listp xscheme-string-receiver) | |
1003 (progn | |
1004 (setq xscheme-string-receiver | |
1005 (car xscheme-string-receiver)) | |
1006 (setq call-noexcursion string)) | |
1007 (funcall xscheme-string-receiver string))) | |
1008 (progn | |
1009 (setq xscheme-string-accumulator | |
1010 (concat xscheme-string-accumulator | |
1011 xscheme-filter-input)) | |
1012 (setq xscheme-filter-input nil))))) | |
1013 (t | |
1014 (error "Scheme process filter -- bad state")))) | |
1015 (if call-noexcursion | |
1016 (funcall xscheme-string-receiver call-noexcursion))))) | |
1017 | |
1018 ;;;; Process Filter Output | |
1019 | |
1020 (defun xscheme-process-filter-output (&rest args) | |
1021 (if xscheme-allow-output-p | |
1022 (let ((string (apply 'concat args))) | |
1023 (save-excursion | |
1024 (xscheme-goto-output-point) | |
1025 (let ((old-point (point))) | |
1026 (while (string-match "\\(\007\\|\f\\)" string) | |
1027 (let ((start (match-beginning 0)) | |
1028 (end (match-end 0))) | |
1029 (insert-before-markers (substring string 0 start)) | |
1030 (if (= ?\f (aref string start)) | |
1031 (progn | |
1032 (if (not (bolp)) | |
1033 (insert-before-markers ?\n)) | |
1034 (insert-before-markers ?\f)) | |
1035 (beep)) | |
1036 (setq string (substring string (1+ start))))) | |
1037 (insert-before-markers string) | |
1038 (if (and xscheme-last-input-end | |
1039 (equal (marker-position xscheme-last-input-end) (point))) | |
1040 (set-marker xscheme-last-input-end old-point))))))) | |
1041 | |
1042 (defun xscheme-guarantee-newlines (n) | |
1043 (if xscheme-allow-output-p | |
1044 (save-excursion | |
1045 (xscheme-goto-output-point) | |
1046 (let ((stop nil)) | |
1047 (while (and (not stop) | |
1048 (bolp)) | |
1049 (setq n (1- n)) | |
1050 (if (bobp) | |
1051 (setq stop t) | |
1052 (backward-char)))) | |
1053 (xscheme-goto-output-point) | |
1054 (while (> n 0) | |
1055 (insert-before-markers ?\n) | |
1056 (setq n (1- n)))))) | |
1057 | |
1058 (defun xscheme-goto-output-point () | |
1059 (let ((process (get-process xscheme-process-name))) | |
1060 (set-buffer (process-buffer process)) | |
1061 (goto-char (process-mark process)))) | |
1062 | |
1063 (defun xscheme-modeline-initialize (name) | |
1064 (setq xscheme-runlight-string "") | |
1065 (if (equal name (default-value 'xscheme-buffer-name)) | |
1066 (setq-default xscheme-runlight-string "")) | |
1067 (setq xscheme-mode-string "") | |
1068 (setq mode-line-buffer-identification | |
1069 (list (concat name ": ") | |
1070 'xscheme-mode-string))) | |
1071 | |
1072 (defun xscheme-set-runlight (runlight) | |
1073 (setq xscheme-runlight-string runlight) | |
1074 (if (equal (buffer-name (current-buffer)) | |
1075 (default-value 'xscheme-buffer-name)) | |
1076 (setq-default xscheme-runlight-string runlight)) | |
1077 (rplaca (nthcdr 3 xscheme-runlight) runlight) | |
1078 (force-mode-line-update t)) | |
1079 | |
1080 (defun xscheme-process-filter:simple-action (action) | |
1081 (setq xscheme-process-filter-state 'idle) | |
1082 (funcall action)) | |
1083 | |
1084 (defun xscheme-process-filter:string-action (action) | |
1085 (setq xscheme-string-receiver action) | |
1086 (setq xscheme-string-accumulator "") | |
1087 (setq xscheme-process-filter-state 'reading-string)) | |
1088 | |
1089 (defun xscheme-process-filter:string-action-noexcursion (action) | |
1090 (xscheme-process-filter:string-action (cons action nil))) | |
1091 | |
1092 (defconst xscheme-runlight:running "run" | |
1093 "The character displayed when the Scheme process is running.") | |
1094 | |
1095 (defconst xscheme-runlight:input "input" | |
1096 "The character displayed when the Scheme process is waiting for input.") | |
1097 | |
1098 (defconst xscheme-runlight:gc "gc" | |
1099 "The character displayed when the Scheme process is garbage collecting.") | |
1100 | |
1101 (defun xscheme-start-gc () | |
1102 (xscheme-set-runlight xscheme-runlight:gc)) | |
1103 | |
1104 (defun xscheme-finish-gc () | |
1105 (xscheme-set-runlight | |
1106 (if xscheme-running-p xscheme-runlight:running xscheme-runlight:input))) | |
1107 | |
1108 (defun xscheme-enter-input-wait () | |
1109 (xscheme-set-runlight xscheme-runlight:input) | |
1110 (setq xscheme-control-g-disabled-p nil) | |
1111 (setq xscheme-running-p nil)) | |
1112 | |
1113 (defun xscheme-exit-input-wait () | |
1114 (xscheme-set-runlight xscheme-runlight:running) | |
1115 (setq xscheme-running-p t)) | |
1116 | |
1117 (defun xscheme-enable-control-g () | |
1118 (setq xscheme-control-g-disabled-p nil) | |
1119 (if (string= (current-message) xscheme-control-g-message-string) | |
1120 (message nil))) | |
1121 | |
1122 (defun xscheme-display-process-buffer () | |
1123 (let ((window (or (xscheme-process-buffer-window) | |
1124 (display-buffer (xscheme-process-buffer))))) | |
1125 (save-window-excursion | |
1126 (select-window window) | |
1127 (xscheme-goto-output-point) | |
1128 (if (xscheme-debugger-mode-p) | |
1129 (xscheme-enter-interaction-mode))))) | |
1130 | |
1131 (defun xscheme-unsolicited-read-char () | |
1132 nil) | |
1133 | |
1134 (defun xscheme-eval (string) | |
1135 (eval (car (read-from-string string)))) | |
1136 | |
1137 (defun xscheme-message (string) | |
1138 (if (not (zerop (length string))) | |
1139 (xscheme-write-message-1 string (format ";%s" string)))) | |
1140 | |
1141 (defun xscheme-write-value (string) | |
1142 (if (zerop (length string)) | |
1143 (xscheme-write-message-1 "(no value)" ";Unspecified return value") | |
1144 (xscheme-write-message-1 string (format ";Value: %s" string)))) | |
1145 | |
1146 (defun xscheme-write-message-1 (message-string output-string) | |
1147 (let* ((process (get-process xscheme-process-name)) | |
1148 (window (get-buffer-window (process-buffer process)))) | |
1149 (if (or (not window) | |
1150 (not (pos-visible-in-window-p (process-mark process) | |
1151 window))) | |
1152 (message "%s" message-string))) | |
1153 (xscheme-guarantee-newlines 1) | |
1154 (xscheme-process-filter-output output-string)) | |
1155 | |
1156 (defun xscheme-set-prompt-variable (string) | |
1157 (setq xscheme-prompt string)) | |
1158 | |
1159 (defun xscheme-set-prompt (string) | |
1160 (setq xscheme-prompt string) | |
1161 (xscheme-guarantee-newlines 2) | |
1162 (setq xscheme-mode-string (xscheme-coerce-prompt string)) | |
1163 (force-mode-line-update t)) | |
1164 | |
1165 (defun xscheme-output-goto () | |
1166 (xscheme-goto-output-point) | |
1167 (xscheme-guarantee-newlines 2)) | |
1168 | |
1169 (defun xscheme-coerce-prompt (string) | |
1170 (if (string-match "^[0-9]+ \\[[^]]+\\] " string) | |
1171 (let ((end (match-end 0))) | |
1172 (xscheme-process-filter-output (substring string end)) | |
1173 (substring string 0 (- end 1))) | |
1174 string)) | |
1175 | |
1176 (defun xscheme-cd (directory-string) | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104922
diff
changeset
|
1177 (with-current-buffer (xscheme-process-buffer) |
50609 | 1178 (cd directory-string))) |
1179 | |
1180 (defun xscheme-prompt-for-confirmation (prompt-string) | |
1181 (xscheme-send-char (if (y-or-n-p prompt-string) ?y ?n))) | |
1182 | |
1183 (defvar xscheme-prompt-for-expression-map nil) | |
1184 (if (not xscheme-prompt-for-expression-map) | |
1185 (progn | |
1186 (setq xscheme-prompt-for-expression-map | |
1187 (copy-keymap minibuffer-local-map)) | |
1188 (substitute-key-definition 'exit-minibuffer | |
1189 'xscheme-prompt-for-expression-exit | |
1190 xscheme-prompt-for-expression-map))) | |
1191 | |
65080
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
1192 (defun xscheme-prompt-for-expression (prompt-string) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
1193 (xscheme-send-string-2 |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
1194 (read-from-minibuffer prompt-string nil xscheme-prompt-for-expression-map))) |
d26d3f3231e8
Trivial changes to silence warnings.
Juanma Barranquero <lekktu@gmail.com>
parents:
64699
diff
changeset
|
1195 |
50609 | 1196 (defun xscheme-prompt-for-expression-exit () |
1197 (interactive) | |
1198 (if (eq (xscheme-region-expression-p (point-min) (point-max)) 'one) | |
1199 (exit-minibuffer) | |
1200 (error "input must be a single, complete expression"))) | |
1201 | |
1202 (defun xscheme-region-expression-p (start end) | |
1203 (save-excursion | |
1204 (let ((old-syntax-table (syntax-table))) | |
1205 (unwind-protect | |
1206 (progn | |
1207 (set-syntax-table scheme-mode-syntax-table) | |
1208 (let ((state (parse-partial-sexp start end))) | |
1209 (and (zerop (car state)) ;depth = 0 | |
1210 (nth 2 state) ;last-sexp exists, i.e. >= 1 sexps | |
1211 (let ((state (parse-partial-sexp start (nth 2 state)))) | |
1212 (if (nth 2 state) 'many 'one))))) | |
1213 (set-syntax-table old-syntax-table))))) | |
1214 | |
1215 (provide 'xscheme) | |
1216 | |
1217 ;;; xscheme.el ends here |