;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el
-;; Copyright (C) 1988, 1994, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1997, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
;; Maintainer: FSF
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; 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..
;; character to the scheme process. Cmuscheme mode does *not* provide this
;; functionality. If you are a cscheme user, you may prefer to use the
;; xscheme.el/cscheme -emacs interaction.
-;;
+;;
;; Here's a summary of the pros and cons, as I see them.
;; xscheme: Tightly integrated with inferior cscheme process! A few commands
;; not in cmuscheme. But. Integration is a bit of a hack. Input
;; history only keeps the immediately prior input. Bizarre
;; keybindings.
-;;
+;;
;; cmuscheme: Not tightly integrated with inferior cscheme process. But.
;; Carefully integrated functionality with the entire suite of
;; comint-derived CMU process modes. Keybindings reminiscent of
;; Zwei and Hemlock. Good input history. A few commands not in
;; xscheme.
-;;
+;;
;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
;; Cscheme-specific; you must use cmuscheme.el. Interested parties are
;;;============================================================================
(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"
(define-key map [switch]
'("Switch to Scheme" . switch-to-scheme))
(define-key map [com-def-go]
- '("Compile Definitiion & Go" . scheme-compile-definition-and-go))
+ '("Compile Definition & Go" . scheme-compile-definition-and-go))
(define-key map [com-def]
- '("Compile Definitiion" . scheme-compile-definition))
+ '("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.
This is a good place to put keybindings."
:type 'hook
:group 'cmuscheme)
-
+
(run-hooks 'cmuscheme-load-hook)
(provide 'cmuscheme)
+;; arch-tag: e8795f4a-c496-45a2-97b4-8e0f2a2c57d2
;;; cmuscheme.el ends here