Mercurial > emacs
comparison lisp/cmuscheme.el @ 64745:cd4c4b49a4c2
(scheme-trace-command, scheme-untrace-command)
(scheme-macro-expand-command): New user options.
(scheme-trace-procedure, scheme-expand-current-form): New commands.
(scheme-form-at-point, scheme-start-file): New functions.
(run-scheme): Call `scheme-start-file' to get start file, and pass it to
`make-comint'.
(switch-to-scheme, scheme-proc): Call `scheme-interactively-start-process'
if no Scheme buffer/process is available.
(scheme-get-process): New function extracted from `scheme-proc'.
(scheme-interactively-start-process): New function.
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Sat, 06 Aug 2005 07:37:45 +0000 |
parents | 6fb026ad601f |
children | 41bb365f41c4 |
comparison
equal
deleted
inserted
replaced
64744:f0a26f676016 | 64745:cd4c4b49a4c2 |
---|---|
125 (define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go) | 125 (define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go) |
126 (define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region) | 126 (define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region) |
127 (define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go) | 127 (define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go) |
128 (define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition) | 128 (define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition) |
129 (define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go) | 129 (define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go) |
130 (define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure) | |
131 (define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form) | |
130 (define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme) | 132 (define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme) |
131 (define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file) | 133 (define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file) |
132 (define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile" | 134 (define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile" |
133 | 135 |
134 (let ((map (lookup-key scheme-mode-map [menu-bar scheme]))) | 136 (let ((map (lookup-key scheme-mode-map [menu-bar scheme]))) |
141 '("Switch to Scheme" . switch-to-scheme)) | 143 '("Switch to Scheme" . switch-to-scheme)) |
142 (define-key map [com-def-go] | 144 (define-key map [com-def-go] |
143 '("Compile Definition & Go" . scheme-compile-definition-and-go)) | 145 '("Compile Definition & Go" . scheme-compile-definition-and-go)) |
144 (define-key map [com-def] | 146 (define-key map [com-def] |
145 '("Compile Definition" . scheme-compile-definition)) | 147 '("Compile Definition" . scheme-compile-definition)) |
148 (define-key map [exp-form] | |
149 '("Expand current form" . scheme-expand-current-form)) | |
150 (define-key map [trace-proc] | |
151 '("Trace procedure" . scheme-trace-procedure)) | |
146 (define-key map [send-def-go] | 152 (define-key map [send-def-go] |
147 '("Evaluate Last Definition & Go" . scheme-send-definition-and-go)) | 153 '("Evaluate Last Definition & Go" . scheme-send-definition-and-go)) |
148 (define-key map [send-def] | 154 (define-key map [send-def] |
149 '("Evaluate Last Definition" . scheme-send-definition)) | 155 '("Evaluate Last Definition" . scheme-send-definition)) |
150 (define-key map [send-region-go] | 156 (define-key map [send-region-go] |
151 '("Evaluate Region & Go" . scheme-send-region-and-go)) | 157 '("Evaluate Region & Go" . scheme-send-region-and-go)) |
152 (define-key map [send-region] | 158 (define-key map [send-region] |
153 '("Evaluate Region" . scheme-send-region)) | 159 '("Evaluate Region" . scheme-send-region)) |
154 (define-key map [send-sexp] | 160 (define-key map [send-sexp] |
155 '("Evaluate Last S-expression" . scheme-send-last-sexp)) | 161 '("Evaluate Last S-expression" . scheme-send-last-sexp)) |
156 ) | 162 ) |
157 | 163 |
158 (defvar scheme-buffer) | 164 (defvar scheme-buffer) |
159 | 165 |
160 (define-derived-mode inferior-scheme-mode comint-mode "Inferior Scheme" | 166 (define-derived-mode inferior-scheme-mode comint-mode "Inferior Scheme" |
161 "Major mode for interacting with an inferior Scheme process. | 167 "Major mode for interacting with an inferior Scheme process. |
231 (scheme-args-to-list (substring string pos | 237 (scheme-args-to-list (substring string pos |
232 (length string))))))))) | 238 (length string))))))))) |
233 | 239 |
234 ;;;###autoload | 240 ;;;###autoload |
235 (defun run-scheme (cmd) | 241 (defun run-scheme (cmd) |
236 "Run an inferior Scheme process, input and output via buffer *scheme*. | 242 "Run an inferior Scheme process, input and output via buffer `*scheme*'. |
237 If there is a process already running in `*scheme*', switch to that buffer. | 243 If there is a process already running in `*scheme*', switch to that buffer. |
238 With argument, allows you to edit the command line (default is value | 244 With argument, allows you to edit the command line (default is value |
239 of `scheme-program-name'). Runs the hooks `inferior-scheme-mode-hook' | 245 of `scheme-program-name'). |
240 \(after the `comint-mode-hook' is run). | 246 If a file `~/.emacs_SCHEMENAME' exists, it is given as initial input. |
247 Note that this may lose due to a timing error if the Scheme processor | |
248 discards input when it starts up. | |
249 Runs the hook `inferior-scheme-mode-hook' \(after the `comint-mode-hook' | |
250 is run). | |
241 \(Type \\[describe-mode] in the process buffer for a list of commands.)" | 251 \(Type \\[describe-mode] in the process buffer for a list of commands.)" |
242 | 252 |
243 (interactive (list (if current-prefix-arg | 253 (interactive (list (if current-prefix-arg |
244 (read-string "Run Scheme: " scheme-program-name) | 254 (read-string "Run Scheme: " scheme-program-name) |
245 scheme-program-name))) | 255 scheme-program-name))) |
246 (if (not (comint-check-proc "*scheme*")) | 256 (if (not (comint-check-proc "*scheme*")) |
247 (let ((cmdlist (scheme-args-to-list cmd))) | 257 (let ((cmdlist (scheme-args-to-list cmd))) |
248 (set-buffer (apply 'make-comint "scheme" (car cmdlist) | 258 (set-buffer (apply 'make-comint "scheme" (car cmdlist) |
249 nil (cdr cmdlist))) | 259 (scheme-start-file (car cmdlist)) (cdr cmdlist))) |
250 (inferior-scheme-mode))) | 260 (inferior-scheme-mode))) |
251 (setq scheme-program-name cmd) | 261 (setq scheme-program-name cmd) |
252 (setq scheme-buffer "*scheme*") | 262 (setq scheme-buffer "*scheme*") |
253 (pop-to-buffer "*scheme*")) | 263 (pop-to-buffer "*scheme*")) |
254 ;;;###autoload (add-hook 'same-window-buffer-names "*scheme*") | 264 ;;;###autoload (add-hook 'same-window-buffer-names "*scheme*") |
265 | |
266 (defun scheme-start-file (prog) | |
267 "Return the name of the start file corresponding to PROG. | |
268 Search in the directories \"~\" and \"~/.emacs.d\", in this | |
269 order. Return nil if no start file found." | |
270 (let* ((name (concat ".emacs_" (file-name-nondirectory prog))) | |
271 (start-file (concat "~/" name))) | |
272 (if (file-exists-p start-file) | |
273 start-file | |
274 (let ((start-file (concat user-emacs-directory name))) | |
275 (and (file-exists-p start-file) start-file))))) | |
255 | 276 |
256 (defun scheme-send-region (start end) | 277 (defun scheme-send-region (start end) |
257 "Send the current region to the inferior Scheme process." | 278 "Send the current region to the inferior Scheme process." |
258 (interactive "r") | 279 (interactive "r") |
259 (comint-send-region (scheme-proc) start end) | 280 (comint-send-region (scheme-proc) start end) |
294 (end-of-defun) | 315 (end-of-defun) |
295 (let ((end (point))) | 316 (let ((end (point))) |
296 (beginning-of-defun) | 317 (beginning-of-defun) |
297 (scheme-compile-region (point) end)))) | 318 (scheme-compile-region (point) end)))) |
298 | 319 |
320 (defcustom scheme-trace-command "(trace %s)" | |
321 "*Template for issuing commands to trace a Scheme procedure. | |
322 Some Scheme implementations might require more elaborate commands here. | |
323 For PLT-Scheme, e.g., one should use | |
324 | |
325 (setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\") | |
326 | |
327 For Scheme 48 and Scsh use \",trace %s\"." | |
328 :type 'string | |
329 :group 'cmuscheme) | |
330 | |
331 (defcustom scheme-untrace-command "(untrace %s)" | |
332 "*Template for switching off tracing of a Scheme procedure. | |
333 Scheme 48 and Scsh users should set this variable to \",untrace %s\"." | |
334 | |
335 :type 'string | |
336 :group 'cmuscheme) | |
337 | |
338 (defun scheme-trace-procedure (proc &optional untrace) | |
339 "Trace procedure PROC in the inferior Scheme process. | |
340 With a prefix argument switch off tracing of procedure PROC." | |
341 (interactive | |
342 (list (let ((current (symbol-at-point)) | |
343 (action (if current-prefix-arg "Untrace" "Trace"))) | |
344 (if current | |
345 (read-string (format "%s procedure [%s]: " action current) nil nil (symbol-name current)) | |
346 (read-string (format "%s procedure: " action)))) | |
347 current-prefix-arg)) | |
348 (when (= (length proc) 0) | |
349 (error "Invalid procedure name")) | |
350 (comint-send-string (scheme-proc) | |
351 (format | |
352 (if untrace scheme-untrace-command scheme-trace-command) | |
353 proc)) | |
354 (comint-send-string (scheme-proc) "\n")) | |
355 | |
356 (defcustom scheme-macro-expand-command "(expand %s)" | |
357 "*Template for macro-expanding a Scheme form. | |
358 For Scheme 48 and Scsh use \",expand %s\"." | |
359 :type 'string | |
360 :group 'cmuscheme) | |
361 | |
362 (defun scheme-expand-current-form () | |
363 "Macro-expand the form at point in the inferior Scheme process." | |
364 (interactive) | |
365 (let ((current-form (scheme-form-at-point))) | |
366 (if current-form | |
367 (progn | |
368 (comint-send-string (scheme-proc) | |
369 (format | |
370 scheme-macro-expand-command | |
371 current-form)) | |
372 (comint-send-string (scheme-proc) "\n")) | |
373 (error "Not at a form")))) | |
374 | |
375 (defun scheme-form-at-point () | |
376 (let ((next-sexp (thing-at-point 'sexp))) | |
377 (if (and next-sexp (string-equal (substring next-sexp 0 1) "(")) | |
378 next-sexp | |
379 (save-excursion | |
380 (backward-up-list) | |
381 (scheme-form-at-point))))) | |
382 | |
299 (defun switch-to-scheme (eob-p) | 383 (defun switch-to-scheme (eob-p) |
300 "Switch to the scheme process buffer. | 384 "Switch to the scheme process buffer. |
301 With argument, position cursor at end of buffer." | 385 With argument, position cursor at end of buffer." |
302 (interactive "P") | 386 (interactive "P") |
303 (if (get-buffer scheme-buffer) | 387 (if (or (and scheme-buffer (get-buffer scheme-buffer)) |
388 (scheme-interactively-start-process)) | |
304 (pop-to-buffer scheme-buffer) | 389 (pop-to-buffer scheme-buffer) |
305 (error "No current process buffer. See variable `scheme-buffer'")) | 390 (error "No current process buffer. See variable `scheme-buffer'")) |
306 (cond (eob-p | 391 (when eob-p |
307 (push-mark) | 392 (push-mark) |
308 (goto-char (point-max))))) | 393 (goto-char (point-max)))) |
309 | 394 |
310 (defun scheme-send-region-and-go (start end) | 395 (defun scheme-send-region-and-go (start end) |
311 "Send the current region to the inferior Scheme process. | 396 "Send the current region to the inferior Scheme process. |
312 Then switch to the process buffer." | 397 Then switch to the process buffer." |
313 (interactive "r") | 398 (interactive "r") |
415 you may wish to consider ilisp.el, a larger, more sophisticated package | 500 you may wish to consider ilisp.el, a larger, more sophisticated package |
416 for running inferior Lisp and Scheme processes. The approach taken here is | 501 for running inferior Lisp and Scheme processes. The approach taken here is |
417 for a minimal, simple implementation. Feel free to extend it.") | 502 for a minimal, simple implementation. Feel free to extend it.") |
418 | 503 |
419 (defun scheme-proc () | 504 (defun scheme-proc () |
420 "Return the current scheme process. See variable `scheme-buffer'." | 505 "Return the current Scheme process, starting one if necessary. |
421 (let ((proc (get-buffer-process (if (eq major-mode 'inferior-scheme-mode) | 506 See variable `scheme-buffer'." |
422 (current-buffer) | 507 (unless (and scheme-buffer |
423 scheme-buffer)))) | 508 (get-buffer scheme-buffer) |
424 (or proc | 509 (comint-check-proc scheme-buffer)) |
425 (error "No current process. See variable `scheme-buffer'")))) | 510 (scheme-interactively-start-process)) |
426 | 511 (or (scheme-get-process) |
512 (error "No current process. See variable `scheme-buffer'"))) | |
513 | |
514 (defun scheme-get-process () | |
515 "Return the current Scheme process or nil if none is running." | |
516 (get-buffer-process (if (eq major-mode 'inferior-scheme-mode) | |
517 (current-buffer) | |
518 scheme-buffer))) | |
519 | |
520 (defun scheme-interactively-start-process (&optional cmd) | |
521 "Start an inferior Scheme process. Return the process started. | |
522 Since this command is run implicitly, always ask the user for the | |
523 command to run." | |
524 (save-window-excursion | |
525 (run-scheme (read-string "Run Scheme: " scheme-program-name)))) | |
427 | 526 |
428 ;;; Do the user's customisation... | 527 ;;; Do the user's customisation... |
429 | 528 |
430 (defcustom cmuscheme-load-hook nil | 529 (defcustom cmuscheme-load-hook nil |
431 "This hook is run when cmuscheme is loaded in. | 530 "This hook is run when cmuscheme is loaded in. |