annotate lisp/progmodes/xscheme.el @ 103408:9a30de718f4d mh-e-doc-8_2

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