Refill some long/short copyright headers.

[bpt/emacs.git] / lisp / progmodes / xscheme.el

diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index 56c4aaa..cd50174 100644 (file)
--- 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, 2009  Free Software Foundation, Inc.
+;; Copyright (C) 1986-1987, 1989-1990, 2001-2011
+;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: languages, lisp
@@ -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")
 \f
 ;;;; 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)
@@ -518,20 +512,18 @@ Commands:
   (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))
+  (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)))))
 \f
 ;;;; 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
@@ -1192,8 +1174,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)))
 \f
 (defun xscheme-prompt-for-confirmation (prompt-string)
@@ -1233,5 +1214,4 @@ the remaining input.")
 
 (provide 'xscheme)
 
-;; arch-tag: cfc14adc-2917-409e-ad16-432e8d0017de
 ;;; xscheme.el ends here