annotate lisp/progmodes/xscheme.el @ 65502:d96d6056d74b

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