X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c1473b4cfeb477ced05d457868c5e1eb97a58eb0..9f46df23a3d01f82a24f2a3dd8730f0263fa9fde:/lisp/progmodes/xscheme.el diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 3726b52688..f9d83da1a3 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -1,7 +1,7 @@ ;;; xscheme.el --- run MIT Scheme under Emacs -;; Copyright (C) 1986, 1987, 1989, 1990, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 -;; Free Software Foundation, Inc. +;; Copyright (C) 1986-1987, 1989-1990, 2001-2012 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: languages, lisp @@ -48,7 +48,7 @@ "Name of xscheme buffer that we're currently interacting with.") (defvar xscheme-expressions-ring-max 30 - "*Maximum length of Scheme expressions ring.") + "Maximum length of Scheme expressions ring.") (defvar xscheme-expressions-ring nil "List of expressions recently transmitted to the Scheme process.") @@ -116,12 +116,12 @@ from being inserted into the process-buffer.") :group 'lisp) (defcustom scheme-band-name nil - "*Band loaded by the `run-scheme' command." + "Band loaded by the `run-scheme' command." :type '(choice (const nil) string) :group 'xscheme) (defcustom scheme-program-arguments nil - "*Arguments passed to the Scheme program by the `run-scheme' command." + "Arguments passed to the Scheme program by the `run-scheme' command." :type '(choice (const nil) string) :group 'xscheme) @@ -134,7 +134,7 @@ has finished evaluating will signal an error." (defcustom xscheme-startup-message "This is the Scheme process buffer. -Type \\[advertised-xscheme-send-previous-expression] to evaluate the expression before point. +Type \\[xscheme-send-previous-expression] to evaluate the expression before point. Type \\[xscheme-send-control-g-interrupt] to abort evaluation. Type \\[describe-mode] for more information. @@ -158,7 +158,8 @@ When called, the current buffer will be the Scheme process-buffer." (defun xscheme-evaluation-commands (keymap) (define-key keymap "\e\C-x" 'xscheme-send-definition) - (define-key keymap "\C-x\C-e" 'advertised-xscheme-send-previous-expression) + (define-key keymap "\C-x\C-e" 'xscheme-send-previous-expression) + (put 'xscheme-send-previous-expression :advertised-binding "\C-x\C-e") (define-key keymap "\eo" 'xscheme-send-buffer) (define-key keymap "\ez" 'xscheme-send-definition) (define-key keymap "\e\C-m" 'xscheme-send-previous-expression) @@ -185,8 +186,7 @@ With argument, asks for a command line." (setq-default xscheme-process-command-line command-line) (switch-to-buffer (xscheme-start-process command-line process-name buffer-name)) - (make-local-variable 'xscheme-process-command-line) - (setq xscheme-process-command-line command-line)) + (set (make-local-variable 'xscheme-process-command-line) command-line)) (defun xscheme-read-command-line (arg) (let ((default @@ -263,8 +263,8 @@ With argument, asks for a command line." (setq-default xscheme-buffer-name buffer-name) (setq-default xscheme-process-name process-name) (setq-default xscheme-runlight-string - (save-excursion (set-buffer buffer-name) - xscheme-runlight-string)) + (with-current-buffer buffer-name + xscheme-runlight-string)) (setq-default xscheme-runlight (if (eq (process-status process-name) 'run) default-xscheme-runlight @@ -277,13 +277,11 @@ With argument, asks for a command line." xscheme-buffer-name t))) (let ((process-name (verify-xscheme-buffer buffer-name t))) - (make-local-variable 'xscheme-buffer-name) - (setq xscheme-buffer-name buffer-name) - (make-local-variable 'xscheme-process-name) - (setq xscheme-process-name process-name) - (make-local-variable 'xscheme-runlight) - (setq xscheme-runlight (save-excursion (set-buffer buffer-name) - xscheme-runlight)))) + (set (make-local-variable 'xscheme-buffer-name) buffer-name) + (set (make-local-variable 'xscheme-process-name) process-name) + (set (make-local-variable 'xscheme-runlight) + (with-current-buffer buffer-name + xscheme-runlight)))) (defun local-clear-scheme-interaction-buffer () "Make the current buffer use the default scheme interaction buffer." @@ -304,8 +302,7 @@ With argument, asks for a command line." ((not process) (error "Buffer `%s' is not a scheme interaction buffer" buffer-name)) (t - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (if (not (xscheme-process-buffer-current-p)) (error "Buffer `%s' is not a scheme interaction buffer" buffer-name))) @@ -317,7 +314,7 @@ With argument, asks for a command line." "Major mode for interacting with an inferior MIT Scheme process. Like scheme-mode except that: -\\[advertised-xscheme-send-previous-expression] sends the expression before point to the Scheme process as input +\\[xscheme-send-previous-expression] sends the expression before point to the Scheme process as input \\[xscheme-yank-pop] yanks an expression previously sent to Scheme \\[xscheme-yank-push] yanks an expression more recently sent to Scheme @@ -386,21 +383,19 @@ Entry to this mode calls the value of scheme-interaction-mode-hook with no args, if that value is non-nil. Likewise with the value of scheme-mode-hook. scheme-interaction-mode-hook is called after scheme-mode-hook." + ;; FIXME: Use define-derived-mode. (interactive "P") (if (not preserve) (let ((previous-mode major-mode)) (kill-all-local-variables) - (make-local-variable 'xscheme-previous-mode) - (make-local-variable 'xscheme-buffer-name) (make-local-variable 'xscheme-process-name) (make-local-variable 'xscheme-previous-process-state) (make-local-variable 'xscheme-runlight-string) (make-local-variable 'xscheme-runlight) - (make-local-variable 'xscheme-last-input-end) - (setq xscheme-previous-mode previous-mode) + (set (make-local-variable 'xscheme-previous-mode) previous-mode) (let ((buffer (current-buffer))) - (setq xscheme-buffer-name (buffer-name buffer)) - (setq xscheme-last-input-end (make-marker)) + (set (make-local-variable 'xscheme-buffer-name) (buffer-name buffer)) + (set (make-local-variable 'xscheme-last-input-end) (make-marker)) (let ((process (get-buffer-process buffer))) (if process (progn @@ -420,7 +415,7 @@ with no args, if that value is non-nil. (defun exit-scheme-interaction-mode () "Take buffer out of scheme interaction mode" (interactive) - (if (not (eq major-mode 'scheme-interaction-mode)) + (if (not (derived-mode-p 'scheme-interaction-mode)) (error "Buffer not in scheme interaction mode")) (let ((previous-state xscheme-previous-process-state)) (funcall xscheme-previous-mode) @@ -437,7 +432,7 @@ with no args, if that value is non-nil. (defun scheme-interaction-mode-initialize () (use-local-map scheme-interaction-mode-map) - (setq major-mode 'scheme-interaction-mode) + (setq major-mode 'scheme-interaction-mode) ;FIXME: Use define-derived-mode. (setq mode-name "Scheme Interaction")) (defun scheme-interaction-mode-commands (keymap) @@ -468,15 +463,14 @@ with no args, if that value is non-nil. (scheme-interaction-mode-commands scheme-interaction-mode-map))) (defun xscheme-enter-interaction-mode () - (save-excursion - (set-buffer (xscheme-process-buffer)) - (if (not (eq major-mode 'scheme-interaction-mode)) - (if (eq major-mode 'scheme-debugger-mode) + (with-current-buffer (xscheme-process-buffer) + (if (not (derived-mode-p 'scheme-interaction-mode)) + (if (derived-mode-p 'scheme-debugger-mode) (scheme-interaction-mode-initialize) (scheme-interaction-mode t))))) -(fset 'advertised-xscheme-send-previous-expression - 'xscheme-send-previous-expression) +(define-obsolete-function-alias 'advertised-xscheme-send-previous-expression + 'xscheme-send-previous-expression "23.2") ;;;; Debugger Mode @@ -495,7 +489,7 @@ Commands: (defun scheme-debugger-mode-initialize () (use-local-map scheme-debugger-mode-map) - (setq major-mode 'scheme-debugger-mode) + (setq major-mode 'scheme-debugger-mode) ;FIXME: Use define-derived-mode. (setq mode-name "Scheme Debugger")) (defun scheme-debugger-mode-commands (keymap) @@ -515,23 +509,21 @@ Commands: (defun scheme-debugger-self-insert () "Transmit this character to the Scheme process." (interactive) - (xscheme-send-char last-command-char)) + (xscheme-send-char last-command-event)) -(defun xscheme-enter-debugger-mode (prompt-string) - (save-excursion - (set-buffer (xscheme-process-buffer)) - (if (not (eq major-mode 'scheme-debugger-mode)) +(defun xscheme-enter-debugger-mode (_prompt-string) + (with-current-buffer (xscheme-process-buffer) + (if (not (derived-mode-p 'scheme-debugger-mode)) (progn - (if (not (eq major-mode 'scheme-interaction-mode)) + (if (not (derived-mode-p 'scheme-interaction-mode)) (scheme-interaction-mode t)) (scheme-debugger-mode-initialize))))) (defun xscheme-debugger-mode-p () (let ((buffer (xscheme-process-buffer))) (and buffer - (save-excursion - (set-buffer buffer) - (eq major-mode 'scheme-debugger-mode))))) + (with-current-buffer buffer + (derived-mode-p 'scheme-debugger-mode))))) ;;;; Evaluation Commands @@ -553,7 +545,7 @@ The strings are concatenated and terminated by a newline." (defun xscheme-send-string-1 (strings) (let ((string (apply 'concat strings))) (xscheme-send-string-2 string) - (if (eq major-mode 'scheme-interaction-mode) + (if (derived-mode-p 'scheme-interaction-mode) (xscheme-insert-expression string)))) (defun xscheme-send-string-2 (string) @@ -704,12 +696,7 @@ parse an expression from the beginning of the line and send that instead." "Send the current line to the Scheme process. Useful for working with debugging Scheme under adb." (interactive) - (let ((line - (save-excursion - (beginning-of-line) - (let ((start (point))) - (end-of-line) - (buffer-substring start (point)))))) + (let ((line (buffer-substring (line-beginning-position) (line-end-position)))) (end-of-line) (insert ?\n) (xscheme-send-string-2 line))) @@ -764,13 +751,11 @@ Control returns to the top level rep loop." (let ((inhibit-quit t)) (cond ((not xscheme-control-g-synchronization-p) (interrupt-process xscheme-process-name)) - ((save-excursion - (set-buffer xscheme-buffer-name) + ((with-current-buffer xscheme-buffer-name xscheme-control-g-disabled-p) (message "Relax...")) (t - (save-excursion - (set-buffer xscheme-buffer-name) + (with-current-buffer xscheme-buffer-name (setq xscheme-control-g-disabled-p t)) (message xscheme-control-g-message-string) (interrupt-process xscheme-process-name) @@ -806,8 +791,7 @@ Control returns to the top level rep loop." (defun xscheme-start-process (command-line the-process the-buffer) (let ((buffer (get-buffer-create the-buffer))) (let ((process (get-buffer-process buffer))) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (if (and process (memq (process-status process) '(run stop))) (set-marker (process-mark process) (point-max)) (progn (if process (delete-process process)) @@ -943,8 +927,7 @@ the remaining input.") (defun xscheme-process-sentinel (proc reason) (let* ((buffer (process-buffer proc)) (name (buffer-name buffer))) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (xscheme-process-filter-initialize (eq reason 'run)) (if (not (eq reason 'run)) (progn @@ -982,8 +965,7 @@ the remaining input.") (call-noexcursion nil)) (while xscheme-filter-input (setq call-noexcursion nil) - (save-excursion - (set-buffer (process-buffer proc)) + (with-current-buffer (process-buffer proc) (cond ((eq xscheme-process-filter-state 'idle) (let ((start (string-match "\e" xscheme-filter-input))) (if start @@ -1042,8 +1024,7 @@ the remaining input.") (xscheme-goto-output-point) (let ((old-point (point))) (while (string-match "\\(\007\\|\f\\)" string) - (let ((start (match-beginning 0)) - (end (match-end 0))) + (let ((start (match-beginning 0))) (insert-before-markers (substring string 0 start)) (if (= ?\f (aref string start)) (progn @@ -1192,8 +1173,7 @@ the remaining input.") string)) (defun xscheme-cd (directory-string) - (save-excursion - (set-buffer (xscheme-process-buffer)) + (with-current-buffer (xscheme-process-buffer) (cd directory-string))) (defun xscheme-prompt-for-confirmation (prompt-string) @@ -1233,5 +1213,4 @@ the remaining input.") (provide 'xscheme) -;; arch-tag: cfc14adc-2917-409e-ad16-432e8d0017de ;;; xscheme.el ends here