+(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)))))
+