annotate lisp/progmodes/xscheme.el @ 62257:89b47aae4ff5

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