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 a820ca4..cd50174 100644 (file)
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -1,17 +1,17 @@
 ;;; xscheme.el --- run MIT Scheme under Emacs
 
 ;;; xscheme.el --- run MIT Scheme under Emacs
 

-;; Copyright (C) 1986, 1987, 1989, 1990, 2001, 2002, 2003, 2004, 2005, 2006, 2007
-;;  Free Software Foundation, Inc.
+;; Copyright (C) 1986-1987, 1989-1990, 2001-2011
+;;   Free Software Foundation, Inc.

 
 ;; Maintainer: FSF
 ;; Keywords: languages, lisp
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Maintainer: FSF
 ;; Keywords: languages, lisp
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -19,9 +19,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -101,17 +99,17 @@ from being inserted into the process-buffer.")
 (setq-default scheme-mode-line-process
              '("" xscheme-runlight))
 
 (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))
+(mapc '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))

 \f
 (defgroup xscheme nil
   "Major mode for editing Scheme and interacting with MIT's C-Scheme."
 \f
 (defgroup xscheme nil
   "Major mode for editing Scheme and interacting with MIT's C-Scheme."


@@ -136,7 +134,7 @@ has finished evaluating will signal an error."
 
 (defcustom xscheme-startup-message
   "This is the Scheme process buffer.
 
 (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.
 
 Type \\[xscheme-send-control-g-interrupt] to abort evaluation.
 Type \\[describe-mode] for more information.
 


@@ -160,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)
 
 (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)
   (define-key keymap "\eo" 'xscheme-send-buffer)
   (define-key keymap "\ez" 'xscheme-send-definition)
   (define-key keymap "\e\C-m" 'xscheme-send-previous-expression)


@@ -187,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))
   (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
 
 (defun xscheme-read-command-line (arg)
   (let ((default


@@ -265,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
     (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
     (setq-default xscheme-runlight
                  (if (eq (process-status process-name) 'run)
                      default-xscheme-runlight


@@ -279,13 +277,11 @@ With argument, asks for a command line."
                      xscheme-buffer-name
                      t)))
   (let ((process-name (verify-xscheme-buffer buffer-name t)))
                      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."
 
 (defun local-clear-scheme-interaction-buffer ()
   "Make the current buffer use the default scheme interaction buffer."


@@ -306,8 +302,7 @@ With argument, asks for a command line."
          ((not process)
           (error "Buffer `%s' is not a scheme interaction buffer" buffer-name))
          (t
          ((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)))
             (if (not (xscheme-process-buffer-current-p))
                 (error "Buffer `%s' is not a scheme interaction buffer"
                        buffer-name)))


@@ -319,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:
 
   "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
 
 \\[xscheme-yank-pop] yanks an expression previously sent to Scheme
 \\[xscheme-yank-push] yanks an expression more recently sent to Scheme
 


@@ -388,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."
 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)
   (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-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)))
         (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
           (let ((process (get-buffer-process buffer)))
             (if process
                 (progn


@@ -422,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)
 (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)
       (error "Buffer not in scheme interaction mode"))
   (let ((previous-state xscheme-previous-process-state))
     (funcall xscheme-previous-mode)


@@ -439,7 +432,7 @@ with no args, if that value is non-nil.
 
 (defun scheme-interaction-mode-initialize ()
   (use-local-map scheme-interaction-mode-map)
 
 (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)
   (setq mode-name "Scheme Interaction"))
 
 (defun scheme-interaction-mode-commands (keymap)


@@ -470,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 ()
       (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)))))
 
            (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
 
 \f
 ;;;; Debugger Mode
 


@@ -497,7 +489,7 @@ Commands:
 
 (defun scheme-debugger-mode-initialize ()
   (use-local-map scheme-debugger-mode-map)
 
 (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)
   (setq mode-name "Scheme Debugger"))
 
 (defun scheme-debugger-mode-commands (keymap)


@@ -517,23 +509,21 @@ Commands:
 (defun scheme-debugger-self-insert ()
   "Transmit this character to the Scheme process."
   (interactive)
 (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)
 
 (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
        (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
              (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
 
 \f
 ;;;; Evaluation Commands
 


@@ -555,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)
 (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)
        (xscheme-insert-expression string))))
 
 (defun xscheme-send-string-2 (string)


@@ -706,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)
   "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)))
     (end-of-line)
     (insert ?\n)
     (xscheme-send-string-2 line)))


@@ -766,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))
   (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
             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)
             (setq xscheme-control-g-disabled-p t))
           (message xscheme-control-g-message-string)
           (interrupt-process xscheme-process-name)


@@ -808,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)))
 (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))
        (if (and process (memq (process-status process) '(run stop)))
            (set-marker (process-mark process) (point-max))
            (progn (if process (delete-process process))


@@ -945,8 +927,7 @@ the remaining input.")
 (defun xscheme-process-sentinel (proc reason)
   (let* ((buffer (process-buffer proc))
         (name (buffer-name buffer)))
 (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
       (xscheme-process-filter-initialize (eq reason 'run))
       (if (not (eq reason 'run))
          (progn


@@ -984,8 +965,7 @@ the remaining input.")
        (call-noexcursion nil))
     (while xscheme-filter-input
       (setq call-noexcursion nil)
        (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
        (cond ((eq xscheme-process-filter-state 'idle)
               (let ((start (string-match "\e" xscheme-filter-input)))
                 (if start


@@ -1194,8 +1174,7 @@ the remaining input.")
       string))
 
 (defun xscheme-cd (directory-string)
       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)
     (cd directory-string)))
 \f
 (defun xscheme-prompt-for-confirmation (prompt-string)


@@ -1235,5 +1214,4 @@ the remaining input.")
 
 (provide 'xscheme)
 
 
 (provide 'xscheme)
 

-;;; arch-tag: cfc14adc-2917-409e-ad16-432e8d0017de

 ;;; xscheme.el ends here
 ;;; xscheme.el ends here