;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el
-;; Copyright (C) 1988, 1994, 1997, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1997, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
;; Maintainer: FSF
;;; Commentary:
-;; This is a customisation of comint-mode (see comint.el)
+;; This is a customization of comint-mode (see comint.el)
;;
;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al..
;;;============================================================================
(defcustom inferior-scheme-mode-hook nil
- "*Hook for customising inferior-scheme mode."
+ "*Hook for customizing inferior-scheme mode."
:type 'hook
:group 'cmuscheme)
(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)
(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)
(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)
+(define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure)
+(define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form)
(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)
(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)
(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"
'("Compile Definition & Go" . scheme-compile-definition-and-go))
(define-key map [com-def]
'("Compile Definition" . scheme-compile-definition))
+ (define-key map [exp-form]
+ '("Expand current form" . scheme-expand-current-form))
+ (define-key map [trace-proc]
+ '("Trace procedure" . scheme-trace-procedure))
(define-key map [send-def-go]
'("Evaluate Last Definition & Go" . scheme-send-definition-and-go))
(define-key map [send-def]
'("Evaluate Region" . scheme-send-region))
(define-key map [send-sexp]
'("Evaluate Last S-expression" . scheme-send-last-sexp))
-)
+ )
(defvar scheme-buffer)
A Scheme process can be fired up with M-x run-scheme.
-Customisation: Entry to this mode runs the hooks on comint-mode-hook and
+Customization: Entry to this mode runs the hooks on comint-mode-hook and
inferior-scheme-mode-hook (in that order).
You can send text to the inferior Scheme process from other buffers containing
Paragraphs are separated only by blank lines. Semicolons start comments.
If you accidentally suspend your process, use \\[comint-continue-subjob]
to continue it."
- ;; Customise in inferior-scheme-mode-hook
+ ;; Customize in inferior-scheme-mode-hook
(setq comint-prompt-regexp "^[^>\n]*>+ *") ; OK for cscheme, oaklisp, T,...
(scheme-mode-variables)
(setq mode-line-process '(":%s"))
;;;###autoload
(defun run-scheme (cmd)
- "Run an inferior Scheme process, input and output via buffer *scheme*.
+ "Run an inferior Scheme process, input and output via buffer `*scheme*'.
If there is a process already running in `*scheme*', switch to that buffer.
With argument, allows you to edit the command line (default is value
-of `scheme-program-name'). Runs the hooks `inferior-scheme-mode-hook'
-\(after the `comint-mode-hook' is run).
+of `scheme-program-name').
+If a file `~/.emacs_SCHEMENAME' exists, it is given as initial input.
+Note that this may lose due to a timing error if the Scheme processor
+discards input when it starts up.
+Runs the hook `inferior-scheme-mode-hook' \(after the `comint-mode-hook'
+is run).
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
(interactive (list (if current-prefix-arg
(if (not (comint-check-proc "*scheme*"))
(let ((cmdlist (scheme-args-to-list cmd)))
(set-buffer (apply 'make-comint "scheme" (car cmdlist)
- nil (cdr cmdlist)))
+ (scheme-start-file (car cmdlist)) (cdr cmdlist)))
(inferior-scheme-mode)))
(setq scheme-program-name cmd)
(setq scheme-buffer "*scheme*")
(pop-to-buffer "*scheme*"))
;;;###autoload (add-hook 'same-window-buffer-names "*scheme*")
+(defun scheme-start-file (prog)
+ "Return the name of the start file corresponding to PROG.
+Search in the directories \"~\" and \"~/.emacs.d\", in this
+order. Return nil if no start file found."
+ (let* ((name (concat ".emacs_" (file-name-nondirectory prog)))
+ (start-file (concat "~/" name)))
+ (if (file-exists-p start-file)
+ start-file
+ (let ((start-file (concat "~/.emacs.d/" name)))
+ (and (file-exists-p start-file) start-file)))))
+
(defun scheme-send-region (start end)
"Send the current region to the inferior Scheme process."
(interactive "r")
(beginning-of-defun)
(scheme-compile-region (point) end))))
+(defcustom scheme-trace-command "(trace %s)"
+ "*Template for issuing commands to trace a Scheme procedure.
+Some Scheme implementations might require more elaborate commands here.
+For PLT-Scheme, e.g., one should use
+
+ (setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\")
+
+For Scheme 48 and Scsh use \",trace %s\"."
+ :type 'string
+ :group 'cmuscheme)
+
+(defcustom scheme-untrace-command "(untrace %s)"
+ "*Template for switching off tracing of a Scheme procedure.
+Scheme 48 and Scsh users should set this variable to \",untrace %s\"."
+
+ :type 'string
+ :group 'cmuscheme)
+
+(defun scheme-trace-procedure (proc &optional untrace)
+ "Trace procedure PROC in the inferior Scheme process.
+With a prefix argument switch off tracing of procedure PROC."
+ (interactive
+ (list (let ((current (symbol-at-point))
+ (action (if current-prefix-arg "Untrace" "Trace")))
+ (if current
+ (read-string (format "%s procedure [%s]: " action current) nil nil (symbol-name current))
+ (read-string (format "%s procedure: " action))))
+ current-prefix-arg))
+ (when (= (length proc) 0)
+ (error "Invalid procedure name"))
+ (comint-send-string (scheme-proc)
+ (format
+ (if untrace scheme-untrace-command scheme-trace-command)
+ proc))
+ (comint-send-string (scheme-proc) "\n"))
+
+(defcustom scheme-macro-expand-command "(expand %s)"
+ "*Template for macro-expanding a Scheme form.
+For Scheme 48 and Scsh use \",expand %s\"."
+ :type 'string
+ :group 'cmuscheme)
+
+(defun scheme-expand-current-form ()
+ "Macro-expand the form at point in the inferior Scheme process."
+ (interactive)
+ (let ((current-form (scheme-form-at-point)))
+ (if current-form
+ (progn
+ (comint-send-string (scheme-proc)
+ (format
+ scheme-macro-expand-command
+ current-form))
+ (comint-send-string (scheme-proc) "\n"))
+ (error "Not at a form"))))
+
+(defun scheme-form-at-point ()
+ (let ((next-sexp (thing-at-point 'sexp)))
+ (if (and next-sexp (string-equal (substring next-sexp 0 1) "("))
+ next-sexp
+ (save-excursion
+ (backward-up-list)
+ (scheme-form-at-point)))))
+
(defun switch-to-scheme (eob-p)
"Switch to the scheme process buffer.
With argument, position cursor at end of buffer."
(interactive "P")
- (if (get-buffer scheme-buffer)
+ (if (or (and scheme-buffer (get-buffer scheme-buffer))
+ (scheme-interactively-start-process))
(pop-to-buffer scheme-buffer)
- (error "No current process buffer. See variable `scheme-buffer'"))
- (cond (eob-p
- (push-mark)
- (goto-char (point-max)))))
+ (error "No current process buffer. See variable `scheme-buffer'"))
+ (when eob-p
+ (push-mark)
+ (goto-char (point-max))))
(defun scheme-send-region-and-go (start end)
"Send the current region to the inferior Scheme process.
(defvar scheme-prev-l/c-dir/file nil
"Caches the last (directory . file) pair.
Caches the last pair used in the last `scheme-load-file' or
-`scheme-compile-file' command. Used for determining the default in the
-next one.")
+`scheme-compile-file' command. Used for determining the default
+in the next one.")
(defun scheme-load-file (file-name)
"Load a Scheme file FILE-NAME into the inferior Scheme process."
for a minimal, simple implementation. Feel free to extend it.")
(defun scheme-proc ()
- "Return the current scheme process. See variable `scheme-buffer'."
- (let ((proc (get-buffer-process (if (eq major-mode 'inferior-scheme-mode)
- (current-buffer)
- scheme-buffer))))
- (or proc
- (error "No current process. See variable `scheme-buffer'"))))
-
-
-;;; Do the user's customisation...
+ "Return the current Scheme process, starting one if necessary.
+See variable `scheme-buffer'."
+ (unless (and scheme-buffer
+ (get-buffer scheme-buffer)
+ (comint-check-proc scheme-buffer))
+ (scheme-interactively-start-process))
+ (or (scheme-get-process)
+ (error "No current process. See variable `scheme-buffer'")))
+
+(defun scheme-get-process ()
+ "Return the current Scheme process or nil if none is running."
+ (get-buffer-process (if (eq major-mode 'inferior-scheme-mode)
+ (current-buffer)
+ scheme-buffer)))
+
+(defun scheme-interactively-start-process (&optional cmd)
+ "Start an inferior Scheme process. Return the process started.
+Since this command is run implicitly, always ask the user for the
+command to run."
+ (save-window-excursion
+ (run-scheme (read-string "Run Scheme: " scheme-program-name))))
+
+;;; Do the user's customization...
(defcustom cmuscheme-load-hook nil
"This hook is run when cmuscheme is loaded in.