X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0ff9b955fe8d8032f5c139dcc86990f0177b646f..d9ca64a98d02f5a3d196896b9f48c39e69e73d44:/lisp/cmuscheme.el diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index 770d5c90c2..622612648f 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -1,6 +1,7 @@ ;;; 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 ;; Maintainer: FSF @@ -20,12 +21,12 @@ ;; 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.. @@ -47,19 +48,19 @@ ;; 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 @@ -105,7 +106,7 @@ ;;;============================================================================ (defcustom inferior-scheme-mode-hook nil - "*Hook for customising inferior-scheme mode." + "*Hook for customizing inferior-scheme mode." :type 'hook :group 'cmuscheme) @@ -127,6 +128,8 @@ (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" @@ -140,9 +143,13 @@ (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] @@ -153,7 +160,7 @@ '("Evaluate Region" . scheme-send-region)) (define-key map [send-sexp] '("Evaluate Last S-expression" . scheme-send-last-sexp)) -) + ) (defvar scheme-buffer) @@ -165,7 +172,7 @@ The following commands are available: 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 @@ -194,7 +201,7 @@ C-M-q does Tab on each line starting within following expression. 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")) @@ -233,11 +240,15 @@ Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters." ;;;###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 @@ -246,13 +257,24 @@ of `scheme-program-name'). Runs the hooks `inferior-scheme-mode-hook' (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") @@ -296,16 +318,80 @@ of `scheme-program-name'). Runs the hooks `inferior-scheme-mode-hook' (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. @@ -346,8 +432,8 @@ Used by these commands to determine defaults." (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." @@ -417,24 +503,39 @@ for running inferior Lisp and Scheme processes. The approach taken here is 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