X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ac72d80baf52b55c91cf18e816089ec807b90502..cdf71ff2ef86e20d8892da4a938a93e1a0c5377b:/lisp/progmodes/xscheme.el diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 609c7db1e2..a820ca4ced 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -1,6 +1,7 @@ ;;; xscheme.el --- run MIT Scheme under Emacs -;; Copyright (C) 1986, 1987, 1989, 1990, 2001, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1986, 1987, 1989, 1990, 2001, 2002, 2003, 2004, 2005, 2006, 2007 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: languages, lisp @@ -9,7 +10,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -19,8 +20,8 @@ ;; 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: @@ -32,6 +33,85 @@ ;;; Code: (require 'scheme) + +;;;; Internal Variables + +(defvar xscheme-previous-mode) +(defvar xscheme-previous-process-state) +(defvar xscheme-last-input-end) + +(defvar xscheme-process-command-line nil + "Command used to start the most recent Scheme process.") + +(defvar xscheme-process-name "scheme" + "Name of xscheme process that we're currently interacting with.") + +(defvar xscheme-buffer-name "*scheme*" + "Name of xscheme buffer that we're currently interacting with.") + +(defvar xscheme-expressions-ring-max 30 + "*Maximum length of Scheme expressions ring.") + +(defvar xscheme-expressions-ring nil + "List of expressions recently transmitted to the Scheme process.") + +(defvar xscheme-expressions-ring-yank-pointer nil + "The tail of the Scheme expressions ring whose car is the last thing yanked.") + +(defvar xscheme-running-p nil + "This variable, if nil, indicates that the scheme process is +waiting for input. Otherwise, it is busy evaluating something.") + +(defconst xscheme-control-g-synchronization-p t + "If non-nil, insert markers in the scheme input stream to indicate when +control-g interrupts were signaled. Do not allow more control-g's to be +signaled until the scheme process acknowledges receipt.") + +(defvar xscheme-control-g-disabled-p nil + "This variable, if non-nil, indicates that a control-g is being processed +by the scheme process, so additional control-g's are to be ignored.") + +(defvar xscheme-string-receiver nil + "Procedure to send the string argument from the scheme process.") + +(defconst default-xscheme-runlight + '(": " xscheme-runlight-string) + "Default global (shared) xscheme-runlight modeline format.") + +(defvar xscheme-runlight "") +(defvar xscheme-runlight-string nil) + +(defvar xscheme-process-filter-state 'idle + "State of scheme process escape reader state machine: +idle waiting for an escape sequence +reading-type received an altmode but nothing else +reading-string reading prompt string") + +(defvar xscheme-allow-output-p t + "This variable, if nil, prevents output from the scheme process +from being inserted into the process-buffer.") + +(defvar xscheme-prompt "" + "The current scheme prompt string.") + +(defvar xscheme-string-accumulator "" + "Accumulator for the string being received from the scheme process.") + +(defvar xscheme-mode-string nil) +(setq-default scheme-mode-line-process + '("" xscheme-runlight)) + +(mapcar 'make-variable-buffer-local + '(xscheme-expressions-ring + xscheme-expressions-ring-yank-pointer + xscheme-process-filter-state + xscheme-running-p + xscheme-control-g-disabled-p + xscheme-allow-output-p + xscheme-prompt + xscheme-string-accumulator + xscheme-mode-string + scheme-mode-line-process)) (defgroup xscheme nil "Major mode for editing Scheme and interacting with MIT's C-Scheme." @@ -337,7 +417,7 @@ with no args, if that value is non-nil. (setq xscheme-previous-process-state (cons nil nil))))))) (scheme-interaction-mode-initialize) (scheme-mode-variables) - (run-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook)) + (run-mode-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook)) (defun exit-scheme-interaction-mode () "Take buffer out of scheme interaction mode" @@ -354,6 +434,9 @@ with no args, if that value is non-nil. (if (eq (process-sentinel process) 'xscheme-process-sentinel) (set-process-sentinel process (cdr previous-state)))))))) +(defvar scheme-interaction-mode-commands-alist nil) +(defvar scheme-interaction-mode-map nil) + (defun scheme-interaction-mode-initialize () (use-local-map scheme-interaction-mode-map) (setq major-mode 'scheme-interaction-mode) @@ -367,7 +450,7 @@ with no args, if that value is non-nil. (car (cdr (car entries)))) (setq entries (cdr entries))))) -(defvar scheme-interaction-mode-commands-alist nil) +;; Initialize the command alist (setq scheme-interaction-mode-commands-alist (append scheme-interaction-mode-commands-alist '(("\C-c\C-m" xscheme-send-current-line) @@ -377,7 +460,7 @@ with no args, if that value is non-nil. ("\ep" xscheme-yank-pop) ("\en" xscheme-yank-push)))) -(defvar scheme-interaction-mode-map nil) +;; Initialize the mode map (if (not scheme-interaction-mode-map) (progn (setq scheme-interaction-mode-map (make-keymap)) @@ -408,7 +491,9 @@ characters perform useful functions. Commands: \\{scheme-debugger-mode-map}" - (error "Illegal entry to scheme-debugger-mode")) + (error "Invalid entry to scheme-debugger-mode")) + +(defvar scheme-debugger-mode-map nil) (defun scheme-debugger-mode-initialize () (use-local-map scheme-debugger-mode-map) @@ -416,12 +501,12 @@ Commands: (setq mode-name "Scheme Debugger")) (defun scheme-debugger-mode-commands (keymap) - (let ((char ? )) + (let ((char ?\s)) (while (< char 127) (define-key keymap (char-to-string char) 'scheme-debugger-self-insert) (setq char (1+ char))))) -(defvar scheme-debugger-mode-map nil) +;; Initialize the debugger mode map (if (not scheme-debugger-mode-map) (progn (setq scheme-debugger-mode-map (make-keymap)) @@ -495,12 +580,9 @@ The strings are concatenated and terminated by a newline." ;;;; Scheme expressions ring (defun xscheme-insert-expression (string) - (setq xscheme-expressions-ring (cons string xscheme-expressions-ring)) - (if (> (length xscheme-expressions-ring) xscheme-expressions-ring-max) - (setcdr (nthcdr (1- xscheme-expressions-ring-max) - xscheme-expressions-ring) - nil)) - (setq xscheme-expressions-ring-yank-pointer xscheme-expressions-ring)) + (setq xscheme-expressions-ring-yank-pointer + (add-to-history 'xscheme-expressions-ring string + xscheme-expressions-ring-max))) (defun xscheme-rotate-yank-pointer (arg) "Rotate the yanking point in the kill ring." @@ -674,6 +756,9 @@ Useful for working with debugging Scheme under adb." (interactive) (process-send-string xscheme-process-name "(proceed)\n")) +(defconst xscheme-control-g-message-string + "Sending C-G interrupt to Scheme...") + (defun xscheme-send-control-g-interrupt () "Cause the Scheme processor to halt and flush input. Control returns to the top level rep loop." @@ -694,9 +779,6 @@ Control returns to the top level rep loop." (sleep-for 0.1) (xscheme-send-char 0))))) -(defconst xscheme-control-g-message-string - "Sending C-G interrupt to Scheme...") - (defun xscheme-send-control-u-interrupt () "Cause the Scheme process to halt, returning to previous rep loop." (interactive) @@ -721,82 +803,6 @@ Control returns to the top level rep loop." (if (and mark-p xscheme-control-g-synchronization-p) (xscheme-send-char 0))) -;;;; Internal Variables - -(defvar xscheme-process-command-line nil - "Command used to start the most recent Scheme process.") - -(defvar xscheme-process-name "scheme" - "Name of xscheme process that we're currently interacting with.") - -(defvar xscheme-buffer-name "*scheme*" - "Name of xscheme buffer that we're currently interacting with.") - -(defvar xscheme-expressions-ring-max 30 - "*Maximum length of Scheme expressions ring.") - -(defvar xscheme-expressions-ring nil - "List of expressions recently transmitted to the Scheme process.") - -(defvar xscheme-expressions-ring-yank-pointer nil - "The tail of the Scheme expressions ring whose car is the last thing yanked.") - -(defvar xscheme-last-input-end) - -(defvar xscheme-process-filter-state 'idle - "State of scheme process escape reader state machine: -idle waiting for an escape sequence -reading-type received an altmode but nothing else -reading-string reading prompt string") - -(defvar xscheme-running-p nil - "This variable, if nil, indicates that the scheme process is -waiting for input. Otherwise, it is busy evaluating something.") - -(defconst xscheme-control-g-synchronization-p t - "If non-nil, insert markers in the scheme input stream to indicate when -control-g interrupts were signaled. Do not allow more control-g's to be -signaled until the scheme process acknowledges receipt.") - -(defvar xscheme-control-g-disabled-p nil - "This variable, if non-nil, indicates that a control-g is being processed -by the scheme process, so additional control-g's are to be ignored.") - -(defvar xscheme-allow-output-p t - "This variable, if nil, prevents output from the scheme process -from being inserted into the process-buffer.") - -(defvar xscheme-prompt "" - "The current scheme prompt string.") - -(defvar xscheme-string-accumulator "" - "Accumulator for the string being received from the scheme process.") - -(defvar xscheme-string-receiver nil - "Procedure to send the string argument from the scheme process.") - -(defconst default-xscheme-runlight - '(": " xscheme-runlight-string) - "Default global (shared) xscheme-runlight modeline format.") - -(defvar xscheme-runlight "") -(defvar xscheme-runlight-string nil) -(defvar xscheme-mode-string nil) -(setq-default scheme-mode-line-process - '("" xscheme-runlight)) - -(mapcar 'make-variable-buffer-local - '(xscheme-expressions-ring - xscheme-expressions-ring-yank-pointer - xscheme-process-filter-state - xscheme-running-p - xscheme-control-g-disabled-p - xscheme-allow-output-p - xscheme-prompt - xscheme-string-accumulator - xscheme-mode-string - scheme-mode-line-process)) - ;;;; Basic Process Control (defun xscheme-start-process (command-line the-process the-buffer) @@ -862,7 +868,7 @@ from being inserted into the process-buffer.") (sleep-for 1))) (defun xscheme-process-running-p () - "True iff there is a Scheme process whose status is `run'." + "True if there is a Scheme process whose status is `run'." (let ((process (get-process xscheme-process-name))) (and process (eq (process-status process) 'run)))) @@ -876,9 +882,64 @@ from being inserted into the process-buffer.") (and buffer (get-buffer-window buffer)))) (defun xscheme-process-buffer-current-p () - "True iff the current buffer is the Scheme process buffer." + "True if the current buffer is the Scheme process buffer." (eq (xscheme-process-buffer) (current-buffer))) +;;;; Process Filter Operations + +(defvar xscheme-process-filter-alist + '((?A xscheme-eval + xscheme-process-filter:string-action-noexcursion) + (?D xscheme-enter-debugger-mode + xscheme-process-filter:string-action) + (?E xscheme-eval + xscheme-process-filter:string-action) + (?P xscheme-set-prompt-variable + xscheme-process-filter:string-action) + (?R xscheme-enter-interaction-mode + xscheme-process-filter:simple-action) + (?b xscheme-start-gc + xscheme-process-filter:simple-action) + (?c xscheme-unsolicited-read-char + xscheme-process-filter:simple-action) + (?e xscheme-finish-gc + xscheme-process-filter:simple-action) + (?f xscheme-exit-input-wait + xscheme-process-filter:simple-action) + (?g xscheme-enable-control-g + xscheme-process-filter:simple-action) + (?i xscheme-prompt-for-expression + xscheme-process-filter:string-action) + (?m xscheme-message + xscheme-process-filter:string-action) + (?n xscheme-prompt-for-confirmation + xscheme-process-filter:string-action) + (?o xscheme-output-goto + xscheme-process-filter:simple-action) + (?p xscheme-set-prompt + xscheme-process-filter:string-action) + (?s xscheme-enter-input-wait + xscheme-process-filter:simple-action) + (?v xscheme-write-value + xscheme-process-filter:string-action) + (?w xscheme-cd + xscheme-process-filter:string-action) + (?z xscheme-display-process-buffer + xscheme-process-filter:simple-action)) + "Table used to decide how to handle process filter commands. +Value is a list of entries, each entry is a list of three items. + +The first item is the character that the process filter dispatches on. +The second item is the action to be taken, a function. +The third item is the handler for the entry, a function. + +When the process filter sees a command whose character matches a +particular entry, it calls the handler with two arguments: the action +and the string containing the rest of the process filter's input +stream. It is the responsibility of the handler to invoke the action +with the appropriate arguments, and to reenter the process filter with +the remaining input.") + ;;;; Process Filter (defun xscheme-process-sentinel (proc reason) @@ -1036,61 +1097,6 @@ from being inserted into the process-buffer.") (rplaca (nthcdr 3 xscheme-runlight) runlight) (force-mode-line-update t)) -;;;; Process Filter Operations - -(defvar xscheme-process-filter-alist - '((?A xscheme-eval - xscheme-process-filter:string-action-noexcursion) - (?D xscheme-enter-debugger-mode - xscheme-process-filter:string-action) - (?E xscheme-eval - xscheme-process-filter:string-action) - (?P xscheme-set-prompt-variable - xscheme-process-filter:string-action) - (?R xscheme-enter-interaction-mode - xscheme-process-filter:simple-action) - (?b xscheme-start-gc - xscheme-process-filter:simple-action) - (?c xscheme-unsolicited-read-char - xscheme-process-filter:simple-action) - (?e xscheme-finish-gc - xscheme-process-filter:simple-action) - (?f xscheme-exit-input-wait - xscheme-process-filter:simple-action) - (?g xscheme-enable-control-g - xscheme-process-filter:simple-action) - (?i xscheme-prompt-for-expression - xscheme-process-filter:string-action) - (?m xscheme-message - xscheme-process-filter:string-action) - (?n xscheme-prompt-for-confirmation - xscheme-process-filter:string-action) - (?o xscheme-output-goto - xscheme-process-filter:simple-action) - (?p xscheme-set-prompt - xscheme-process-filter:string-action) - (?s xscheme-enter-input-wait - xscheme-process-filter:simple-action) - (?v xscheme-write-value - xscheme-process-filter:string-action) - (?w xscheme-cd - xscheme-process-filter:string-action) - (?z xscheme-display-process-buffer - xscheme-process-filter:simple-action)) - "Table used to decide how to handle process filter commands. -Value is a list of entries, each entry is a list of three items. - -The first item is the character that the process filter dispatches on. -The second item is the action to be taken, a function. -The third item is the handler for the entry, a function. - -When the process filter sees a command whose character matches a -particular entry, it calls the handler with two arguments: the action -and the string containing the rest of the process filter's input -stream. It is the responsibility of the handler to invoke the action -with the appropriate arguments, and to reenter the process filter with -the remaining input.") - (defun xscheme-process-filter:simple-action (action) (setq xscheme-process-filter-state 'idle) (funcall action)) @@ -1195,10 +1201,6 @@ the remaining input.") (defun xscheme-prompt-for-confirmation (prompt-string) (xscheme-send-char (if (y-or-n-p prompt-string) ?y ?n))) -(defun xscheme-prompt-for-expression (prompt-string) - (xscheme-send-string-2 - (read-from-minibuffer prompt-string nil xscheme-prompt-for-expression-map))) - (defvar xscheme-prompt-for-expression-map nil) (if (not xscheme-prompt-for-expression-map) (progn @@ -1208,6 +1210,10 @@ the remaining input.") 'xscheme-prompt-for-expression-exit xscheme-prompt-for-expression-map))) +(defun xscheme-prompt-for-expression (prompt-string) + (xscheme-send-string-2 + (read-from-minibuffer prompt-string nil xscheme-prompt-for-expression-map))) + (defun xscheme-prompt-for-expression-exit () (interactive) (if (eq (xscheme-region-expression-p (point-min) (point-max)) 'one)