Commit | Line | Data |
---|---|---|
731bcf73 NJ |
1 | ;;; gds-scheme.el -- GDS function for Scheme mode buffers |
2 | ||
3 | ;;;; Copyright (C) 2005 Neil Jerram | |
4 | ;;;; | |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 8 | ;;;; version 3 of the License, or (at your option) any later version. |
731bcf73 NJ |
9 | ;;;; |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free | |
17 | ;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA | |
18 | ;;;; 02111-1307 USA | |
19 | ||
20 | (require 'comint) | |
21 | (require 'scheme) | |
22 | (require 'derived) | |
23 | (require 'pp) | |
24 | ||
25 | ;;;; Maintaining an association between a Guile client process and a | |
26 | ;;;; set of Scheme mode buffers. | |
27 | ||
28 | (defcustom gds-auto-create-utility-client t | |
29 | "Whether to automatically create a utility Guile client, and | |
30 | associate the current buffer with it, if there are no existing Guile | |
31 | clients available to GDS when the user does something that requires a | |
32 | running Guile client." | |
33 | :type 'boolean | |
34 | :group 'gds) | |
35 | ||
36 | (defcustom gds-auto-associate-single-client t | |
37 | "Whether to automatically associate the current buffer with an | |
38 | existing Guile client, if there is only only client known to GDS when | |
39 | the user does something that requires a running Guile client, and the | |
40 | current buffer is not already associated with a Guile client." | |
41 | :type 'boolean | |
42 | :group 'gds) | |
43 | ||
44 | (defcustom gds-auto-associate-last-client t | |
45 | "Whether to automatically associate the current buffer with the | |
46 | Guile client that most recently caused that buffer to be displayed, | |
47 | when the user does something that requires a running Guile client and | |
48 | the current buffer is not already associated with a Guile client." | |
49 | :type 'boolean | |
50 | :group 'gds) | |
51 | ||
52 | (defvar gds-last-touched-by nil | |
53 | "For each Scheme mode buffer, this records the GDS client that most | |
54 | recently `touched' that buffer in the sense of using it to display | |
55 | source code, for example for the source code relevant to a debugger | |
56 | stack frame.") | |
57 | (make-variable-buffer-local 'gds-last-touched-by) | |
58 | ||
59 | (defun gds-auto-associate-buffer () | |
60 | "Automatically associate the current buffer with a Guile client, if | |
61 | possible." | |
62 | (let* ((num-clients (length gds-client-info)) | |
63 | (client | |
64 | (or | |
65 | ;; If there are no clients yet, and | |
66 | ;; `gds-auto-create-utility-client' allows us to create one | |
67 | ;; automatically, do that. | |
68 | (and (= num-clients 0) | |
69 | gds-auto-create-utility-client | |
70 | (gds-start-utility-guile)) | |
71 | ;; Otherwise, if there is a single existing client, and | |
72 | ;; `gds-auto-associate-single-client' allows us to use it | |
73 | ;; for automatic association, do that. | |
74 | (and (= num-clients 1) | |
75 | gds-auto-associate-single-client | |
76 | (caar gds-client-info)) | |
77 | ;; Otherwise, if the current buffer was displayed because | |
78 | ;; of a Guile client trapping somewhere in its code, and | |
79 | ;; `gds-auto-associate-last-client' allows us to associate | |
80 | ;; with that client, do so. | |
81 | (and gds-auto-associate-last-client | |
82 | gds-last-touched-by)))) | |
83 | (if client | |
84 | (gds-associate-buffer client)))) | |
85 | ||
86 | (defun gds-associate-buffer (client) | |
87 | "Associate the current buffer with the Guile process CLIENT. | |
88 | This means that operations in this buffer that require a running Guile | |
89 | process - such as evaluation, help, completion and setting traps - | |
90 | will be sent to the Guile process whose name or connection number is | |
91 | CLIENT." | |
92 | (interactive (list (gds-choose-client))) | |
93 | ;; If this buffer is already associated, dissociate from its | |
94 | ;; existing client first. | |
95 | (if gds-client (gds-dissociate-buffer)) | |
96 | ;; Store the client number in the buffer-local variable gds-client. | |
97 | (setq gds-client client) | |
98 | ;; Add this buffer to the list of buffers associated with the | |
99 | ;; client. | |
100 | (gds-client-put client 'associated-buffers | |
101 | (cons (current-buffer) | |
102 | (gds-client-get client 'associated-buffers)))) | |
103 | ||
104 | (defun gds-dissociate-buffer () | |
105 | "Dissociate the current buffer from any specific Guile process." | |
106 | (interactive) | |
107 | (if gds-client | |
108 | (progn | |
109 | ;; Remove this buffer from the list of buffers associated with | |
110 | ;; the current client. | |
111 | (gds-client-put gds-client 'associated-buffers | |
112 | (delq (current-buffer) | |
113 | (gds-client-get gds-client 'associated-buffers))) | |
114 | ;; Reset the buffer-local variable gds-client. | |
115 | (setq gds-client nil) | |
116 | ;; Clear any process status indication from the modeline. | |
117 | (setq mode-line-process nil) | |
118 | (force-mode-line-update)))) | |
119 | ||
120 | (defun gds-show-client-status (client status-string) | |
121 | "Show a client's status in the modeline of all its associated | |
122 | buffers." | |
123 | (let ((buffers (gds-client-get client 'associated-buffers))) | |
124 | (while buffers | |
125 | (if (buffer-live-p (car buffers)) | |
126 | (with-current-buffer (car buffers) | |
127 | (setq mode-line-process status-string) | |
128 | (force-mode-line-update))) | |
129 | (setq buffers (cdr buffers))))) | |
130 | ||
131 | (defcustom gds-running-text ":running" | |
132 | "*Mode line text used to show that a Guile process is \"running\". | |
133 | \"Running\" means that the process cannot currently accept any input | |
134 | from the GDS frontend in Emacs, because all of its threads are busy | |
135 | running code that GDS cannot easily interrupt." | |
136 | :type 'string | |
137 | :group 'gds) | |
138 | ||
139 | (defcustom gds-ready-text ":ready" | |
140 | "*Mode line text used to show that a Guile process is \"ready\". | |
141 | \"Ready\" means that the process is ready to interact with the GDS | |
142 | frontend in Emacs, because at least one of its threads is waiting for | |
143 | GDS input." | |
144 | :type 'string | |
145 | :group 'gds) | |
146 | ||
147 | (defcustom gds-debug-text ":debug" | |
148 | "*Mode line text used to show that a Guile process is \"debugging\". | |
149 | \"Debugging\" means that the process is using the GDS frontend in | |
150 | Emacs to display an error or trap so that the user can debug it." | |
151 | :type 'string | |
152 | :group 'gds) | |
153 | ||
154 | (defun gds-choose-client () | |
155 | "Ask the user to choose a GDS client process from a list." | |
156 | (let ((table '()) | |
157 | (default nil)) | |
158 | ;; Prepare a table containing all current clients. | |
159 | (mapcar (lambda (client-info) | |
19b16cd0 | 160 | (setq table (cons (cons (cadr (memq 'name client-info)) |
731bcf73 NJ |
161 | (car client-info)) |
162 | table))) | |
163 | gds-client-info) | |
164 | ;; Add an entry to allow the user to ask for a new process. | |
165 | (setq table (cons (cons "Start a new Guile process" nil) table)) | |
166 | ;; Work out a good default. If the buffer has a good value in | |
167 | ;; gds-last-touched-by, we use that; otherwise default to starting | |
168 | ;; a new process. | |
169 | (setq default (or (and gds-last-touched-by | |
170 | (gds-client-get gds-last-touched-by 'name)) | |
171 | (caar table))) | |
172 | ;; Read using this table. | |
173 | (let* ((name (completing-read "Choose a Guile process: " | |
174 | table | |
175 | nil | |
176 | t ; REQUIRE-MATCH | |
177 | nil ; INITIAL-INPUT | |
178 | nil ; HIST | |
179 | default)) | |
180 | ;; Convert name to a client number. | |
181 | (client (cdr (assoc name table)))) | |
182 | ;; If the user asked to start a new Guile process, do that now. | |
183 | (or client (setq client (gds-start-utility-guile))) | |
184 | ;; Return the chosen client ID. | |
185 | client))) | |
186 | ||
187 | (defvar gds-last-utility-number 0 | |
188 | "Number of the last started Guile utility process.") | |
189 | ||
190 | (defun gds-start-utility-guile () | |
191 | "Start a new utility Guile process." | |
192 | (setq gds-last-utility-number (+ gds-last-utility-number 1)) | |
193 | (let* ((procname (format "gds-util[%d]" gds-last-utility-number)) | |
194 | (code (format "(begin | |
195 | %s | |
fce4b99e | 196 | (use-modules (ice-9 gds-client)) |
731bcf73 NJ |
197 | (run-utility))" |
198 | (if gds-scheme-directory | |
199 | (concat "(set! %load-path (cons " | |
200 | (format "%S" gds-scheme-directory) | |
201 | " %load-path))") | |
202 | ""))) | |
203 | (proc (start-process procname | |
204 | (get-buffer-create procname) | |
205 | gds-guile-program | |
206 | "-q" | |
207 | "--debug" | |
208 | "-c" | |
a27173cf | 209 | code))) |
731bcf73 NJ |
210 | ;; Note that this process can be killed automatically on Emacs |
211 | ;; exit. | |
212 | (process-kill-without-query proc) | |
213 | ;; Set up a process filter to catch the new client's number. | |
214 | (set-process-filter proc | |
215 | (lambda (proc string) | |
731bcf73 NJ |
216 | (if (process-buffer proc) |
217 | (with-current-buffer (process-buffer proc) | |
c0d316cc | 218 | (insert string) |
a27173cf | 219 | (or gds-client |
c0d316cc NJ |
220 | (save-excursion |
221 | (goto-char (point-min)) | |
a27173cf NJ |
222 | (setq gds-client |
223 | (condition-case nil | |
224 | (read (current-buffer)) | |
225 | (error nil))))))))) | |
731bcf73 | 226 | ;; Accept output from the new process until we have its number. |
a27173cf | 227 | (while (not (with-current-buffer (process-buffer proc) gds-client)) |
731bcf73 NJ |
228 | (accept-process-output proc)) |
229 | ;; Return the new process's client number. | |
a27173cf | 230 | (with-current-buffer (process-buffer proc) gds-client))) |
731bcf73 NJ |
231 | |
232 | ;;;; Evaluating code. | |
233 | ||
234 | ;; The following commands send code for evaluation through the GDS TCP | |
235 | ;; connection, receive the result and any output generated through the | |
236 | ;; same connection, and display the result and output to the user. | |
237 | ;; | |
238 | ;; For each buffer where evaluations can be requested, GDS uses the | |
239 | ;; buffer-local variable `gds-client' to track which GDS client | |
240 | ;; program should receive and handle that buffer's evaluations. | |
241 | ||
242 | (defun gds-module-name (start end) | |
243 | "Determine and return the name of the module that governs the | |
244 | specified region. The module name is returned as a list of symbols." | |
245 | (interactive "r") ; why not? | |
246 | (save-excursion | |
247 | (goto-char start) | |
248 | (let (module-name) | |
249 | (while (and (not module-name) | |
250 | (beginning-of-defun-raw 1)) | |
251 | (if (looking-at "(define-module ") | |
252 | (setq module-name | |
253 | (progn | |
254 | (goto-char (match-end 0)) | |
255 | (read (current-buffer)))))) | |
256 | module-name))) | |
257 | ||
258 | (defcustom gds-emacs-buffer-port-name-prefix "Emacs buffer: " | |
259 | "Prefix used when telling Guile the name of the port from which a | |
260 | chunk of Scheme code (to be evaluated) comes. GDS uses this prefix, | |
261 | followed by the buffer name, in two cases: when the buffer concerned | |
262 | is not associated with a file, or if the buffer has been modified | |
263 | since last saving to its file. In the case where the buffer is | |
264 | identical to a saved file, GDS uses the file name as the port name." | |
265 | :type '(string) | |
266 | :group 'gds) | |
267 | ||
268 | (defun gds-port-name (start end) | |
269 | "Return port name for the specified region of the current buffer. | |
270 | The name will be used by Guile as the port name when evaluating that | |
271 | region's code." | |
272 | (or (and (not (buffer-modified-p)) | |
273 | buffer-file-name) | |
274 | (concat gds-emacs-buffer-port-name-prefix (buffer-name)))) | |
275 | ||
276 | (defun gds-line-and-column (pos) | |
277 | "Return 0-based line and column number at POS." | |
278 | (let (line column) | |
279 | (save-excursion | |
280 | (goto-char pos) | |
281 | (setq column (current-column)) | |
282 | (beginning-of-line) | |
283 | (setq line (count-lines (point-min) (point)))) | |
284 | (cons line column))) | |
285 | ||
091baf9e NJ |
286 | (defun gds-eval-region (start end &optional debugp) |
287 | "Evaluate the current region. If invoked with `C-u' prefix (or, in | |
288 | a program, with optional DEBUGP arg non-nil), pause and pop up the | |
289 | stack at the start of the evaluation, so that the user can single-step | |
290 | through the code." | |
291 | (interactive "r\nP") | |
731bcf73 NJ |
292 | (or gds-client |
293 | (gds-auto-associate-buffer) | |
294 | (call-interactively 'gds-associate-buffer)) | |
295 | (let ((module (gds-module-name start end)) | |
296 | (port-name (gds-port-name start end)) | |
297 | (lc (gds-line-and-column start))) | |
298 | (let ((code (buffer-substring-no-properties start end))) | |
091baf9e | 299 | (gds-send (format "eval (region . %S) %s %S %d %d %S %s" |
731bcf73 NJ |
300 | (gds-abbreviated code) |
301 | (if module (prin1-to-string module) "#f") | |
302 | port-name (car lc) (cdr lc) | |
091baf9e NJ |
303 | code |
304 | (if debugp '(debug) '(none))) | |
731bcf73 NJ |
305 | gds-client)))) |
306 | ||
091baf9e NJ |
307 | (defun gds-eval-expression (expr &optional correlator debugp) |
308 | "Evaluate the supplied EXPR (a string). If invoked with `C-u' | |
309 | prefix (or, in a program, with optional DEBUGP arg non-nil), pause and | |
310 | pop up the stack at the start of the evaluation, so that the user can | |
311 | single-step through the code." | |
312 | (interactive "sEvaluate expression: \ni\nP") | |
731bcf73 NJ |
313 | (or gds-client |
314 | (gds-auto-associate-buffer) | |
315 | (call-interactively 'gds-associate-buffer)) | |
316 | (set-text-properties 0 (length expr) nil expr) | |
091baf9e | 317 | (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S %s" |
731bcf73 NJ |
318 | (or correlator 'expression) |
319 | (gds-abbreviated expr) | |
091baf9e NJ |
320 | expr |
321 | (if debugp '(debug) '(none))) | |
731bcf73 NJ |
322 | gds-client)) |
323 | ||
324 | (defconst gds-abbreviated-length 35) | |
325 | ||
326 | (defun gds-abbreviated (code) | |
327 | (let ((nlpos (string-match (regexp-quote "\n") code))) | |
328 | (while nlpos | |
329 | (setq code | |
330 | (if (= nlpos (- (length code) 1)) | |
331 | (substring code 0 nlpos) | |
332 | (concat (substring code 0 nlpos) | |
333 | "\\n" | |
334 | (substring code (+ nlpos 1))))) | |
335 | (setq nlpos (string-match (regexp-quote "\n") code)))) | |
336 | (if (> (length code) gds-abbreviated-length) | |
337 | (concat (substring code 0 (- gds-abbreviated-length 3)) "...") | |
338 | code)) | |
339 | ||
091baf9e NJ |
340 | (defun gds-eval-defun (&optional debugp) |
341 | "Evaluate the defun (top-level form) at point. If invoked with | |
342 | `C-u' prefix (or, in a program, with optional DEBUGP arg non-nil), | |
343 | pause and pop up the stack at the start of the evaluation, so that the | |
344 | user can single-step through the code." | |
345 | (interactive "P") | |
731bcf73 NJ |
346 | (save-excursion |
347 | (end-of-defun) | |
348 | (let ((end (point))) | |
349 | (beginning-of-defun) | |
091baf9e NJ |
350 | (gds-eval-region (point) end debugp)))) |
351 | ||
352 | (defun gds-eval-last-sexp (&optional debugp) | |
353 | "Evaluate the sexp before point. If invoked with `C-u' prefix (or, | |
354 | in a program, with optional DEBUGP arg non-nil), pause and pop up the | |
355 | stack at the start of the evaluation, so that the user can single-step | |
356 | through the code." | |
357 | (interactive "P") | |
358 | (gds-eval-region (save-excursion (backward-sexp) (point)) (point) debugp)) | |
731bcf73 NJ |
359 | |
360 | ;;;; Help. | |
361 | ||
362 | ;; Help is implemented as a special case of evaluation, identified by | |
363 | ;; the evaluation correlator 'help. | |
364 | ||
365 | (defun gds-help-symbol (sym) | |
366 | "Get help for SYM (a Scheme symbol)." | |
367 | (interactive | |
368 | (let ((sym (thing-at-point 'symbol)) | |
369 | (enable-recursive-minibuffers t) | |
370 | val) | |
371 | (setq val (read-from-minibuffer | |
372 | (if sym | |
373 | (format "Describe Guile symbol (default %s): " sym) | |
374 | "Describe Guile symbol: "))) | |
375 | (list (if (zerop (length val)) sym val)))) | |
376 | (gds-eval-expression (format "(help %s)" sym) 'help)) | |
377 | ||
378 | (defun gds-apropos (regex) | |
379 | "List Guile symbols matching REGEX." | |
380 | (interactive | |
381 | (let ((sym (thing-at-point 'symbol)) | |
382 | (enable-recursive-minibuffers t) | |
383 | val) | |
384 | (setq val (read-from-minibuffer | |
385 | (if sym | |
386 | (format "Guile apropos (regexp, default \"%s\"): " sym) | |
387 | "Guile apropos (regexp): "))) | |
388 | (list (if (zerop (length val)) sym val)))) | |
389 | (set-text-properties 0 (length regex) nil regex) | |
390 | (gds-eval-expression (format "(apropos %S)" regex) 'apropos)) | |
391 | ||
392 | ;;;; Displaying results of help and eval. | |
393 | ||
394 | (defun gds-display-results (client correlator stack-available results) | |
395 | (let* ((helpp+bufname (cond ((eq (car correlator) 'help) | |
396 | '(t . "*Guile Help*")) | |
397 | ((eq (car correlator) 'apropos) | |
398 | '(t . "*Guile Apropos*")) | |
399 | (t | |
400 | '(nil . "*Guile Evaluation*")))) | |
401 | (helpp (car helpp+bufname))) | |
402 | (let ((buf (get-buffer-create (cdr helpp+bufname)))) | |
ed1dec3c NJ |
403 | (save-selected-window |
404 | (save-excursion | |
405 | (set-buffer buf) | |
406 | (gds-dissociate-buffer) | |
407 | (erase-buffer) | |
408 | (scheme-mode) | |
409 | (insert (cdr correlator) "\n\n") | |
410 | (while results | |
411 | (insert (car results)) | |
412 | (or (bolp) (insert "\\\n")) | |
413 | (if helpp | |
414 | nil | |
415 | (if (cadr results) | |
416 | (mapcar (function (lambda (value) | |
417 | (insert " => " value "\n"))) | |
418 | (cadr results)) | |
419 | (insert " => no (or unspecified) value\n")) | |
420 | (insert "\n")) | |
421 | (setq results (cddr results))) | |
422 | (if stack-available | |
423 | (let ((beg (point)) | |
424 | (map (make-sparse-keymap))) | |
425 | (define-key map [mouse-1] 'gds-show-last-stack) | |
426 | (define-key map "\C-m" 'gds-show-last-stack) | |
e8e655e2 | 427 | (insert "[click here (or RET) to show error stack]") |
ed1dec3c NJ |
428 | (add-text-properties beg (point) |
429 | (list 'keymap map | |
430 | 'mouse-face 'highlight)) | |
e8e655e2 NJ |
431 | (insert "\n") |
432 | (add-text-properties (1- (point)) (point) | |
433 | (list 'keymap map)))) | |
ed1dec3c NJ |
434 | (goto-char (point-min)) |
435 | (gds-associate-buffer client)) | |
436 | (pop-to-buffer buf) | |
437 | (run-hooks 'temp-buffer-show-hook))))) | |
731bcf73 NJ |
438 | |
439 | (defun gds-show-last-stack () | |
440 | "Show stack of the most recent error." | |
441 | (interactive) | |
442 | (or gds-client | |
443 | (gds-auto-associate-buffer) | |
444 | (call-interactively 'gds-associate-buffer)) | |
445 | (gds-send "debug-lazy-trap-context" gds-client)) | |
446 | ||
447 | ;;;; Completion. | |
448 | ||
449 | (defvar gds-completion-results nil) | |
450 | ||
451 | (defun gds-complete-symbol () | |
452 | "Complete the Guile symbol before point. Returns `t' if anything | |
453 | interesting happened, `nil' if not." | |
454 | (interactive) | |
455 | (or gds-client | |
456 | (gds-auto-associate-buffer) | |
457 | (call-interactively 'gds-associate-buffer)) | |
458 | (let* ((chars (- (point) (save-excursion | |
459 | (while (let ((syntax (char-syntax (char-before (point))))) | |
460 | (or (eq syntax ?w) (eq syntax ?_))) | |
461 | (forward-char -1)) | |
462 | (point))))) | |
463 | (if (zerop chars) | |
464 | nil | |
465 | (setq gds-completion-results nil) | |
466 | (gds-send (format "complete %s" | |
467 | (prin1-to-string | |
468 | (buffer-substring-no-properties (- (point) chars) | |
469 | (point)))) | |
470 | gds-client) | |
471 | (while (null gds-completion-results) | |
472 | (accept-process-output gds-debug-server 0 200)) | |
473 | (cond ((eq gds-completion-results 'error) | |
474 | (error "Internal error - please report the contents of the *Guile Evaluation* window")) | |
475 | ((eq gds-completion-results t) | |
476 | nil) | |
477 | ((stringp gds-completion-results) | |
478 | (if (<= (length gds-completion-results) chars) | |
479 | nil | |
480 | (insert (substring gds-completion-results chars)) | |
481 | (message "Sole completion") | |
482 | t)) | |
483 | ((= (length gds-completion-results) 1) | |
484 | (if (<= (length (car gds-completion-results)) chars) | |
485 | nil | |
486 | (insert (substring (car gds-completion-results) chars)) | |
487 | t)) | |
488 | (t | |
489 | (with-output-to-temp-buffer "*Completions*" | |
490 | (display-completion-list gds-completion-results)) | |
491 | t))))) | |
492 | ||
731bcf73 NJ |
493 | ;;;; Dispatcher for non-debug protocol. |
494 | ||
495 | (defun gds-nondebug-protocol (client proc args) | |
496 | (cond (;; (eval-results ...) - Results of evaluation. | |
497 | (eq proc 'eval-results) | |
498 | (gds-display-results client (car args) (cadr args) (cddr args)) | |
499 | ;; If these results indicate an error, set | |
500 | ;; gds-completion-results to non-nil in case the error arose | |
501 | ;; when trying to do a completion. | |
502 | (if (eq (caar args) 'error) | |
503 | (setq gds-completion-results 'error))) | |
504 | ||
505 | (;; (completion-result ...) - Available completions. | |
506 | (eq proc 'completion-result) | |
507 | (setq gds-completion-results (or (car args) t))) | |
508 | ||
731bcf73 NJ |
509 | (;; (note ...) - For debugging only. |
510 | (eq proc 'note)) | |
511 | ||
512 | (;; (trace ...) - Tracing. | |
513 | (eq proc 'trace) | |
514 | (with-current-buffer (get-buffer-create "*GDS Trace*") | |
515 | (save-excursion | |
516 | (goto-char (point-max)) | |
517 | (or (bolp) (insert "\n")) | |
518 | (insert "[client " (number-to-string client) "] " (car args) "\n")))) | |
519 | ||
520 | (t | |
521 | ;; Unexpected. | |
522 | (error "Bad protocol: %S" form)))) | |
523 | ||
524 | ;;;; Scheme mode keymap items. | |
525 | ||
526 | (define-key scheme-mode-map "\M-\C-x" 'gds-eval-defun) | |
527 | (define-key scheme-mode-map "\C-x\C-e" 'gds-eval-last-sexp) | |
528 | (define-key scheme-mode-map "\C-c\C-e" 'gds-eval-expression) | |
529 | (define-key scheme-mode-map "\C-c\C-r" 'gds-eval-region) | |
530 | (define-key scheme-mode-map "\C-hg" 'gds-help-symbol) | |
531 | (define-key scheme-mode-map "\C-h\C-g" 'gds-apropos) | |
6d6a3fe2 NJ |
532 | (define-key scheme-mode-map "\C-hG" 'gds-apropos) |
533 | (define-key scheme-mode-map "\C-hS" 'gds-show-last-stack) | |
731bcf73 | 534 | (define-key scheme-mode-map "\e\t" 'gds-complete-symbol) |
731bcf73 NJ |
535 | |
536 | ;;;; The end! | |
537 | ||
538 | (provide 'gds-scheme) | |
539 | ||
540 | ;;; gds-scheme.el ends here. |