;;; xscheme.el --- run MIT Scheme under Emacs
-;; Copyright (C) 1986, 1987, 1989, 1990, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 1986-1987, 1989-1990, 2001-2014 Free Software
+;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, lisp
;; This file is part of GNU Emacs.
;;;; Internal Variables
(defvar xscheme-previous-mode)
-(defvar xscheme-previous-process-state)
(defvar xscheme-last-input-end)
(defvar xscheme-process-command-line nil
"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.")
(defconst default-xscheme-runlight
'(": " xscheme-runlight-string)
- "Default global (shared) xscheme-runlight modeline format.")
+ "Default global (shared) xscheme-runlight mode line format.")
(defvar xscheme-runlight "")
(defvar xscheme-runlight-string nil)
: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)
(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
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 (with-current-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."
in the minibuffer. If an error occurs, the process buffer will
automatically pop up to show you the error message.
-While the Scheme process is running, the modelines of all buffers in
+While the Scheme process is running, the mode lines of all buffers in
scheme-mode are modified to show the state of the process. The
possible states and their meanings are:
run evaluating
gc garbage collecting
-The process buffer's modeline contains additional information where
+The process buffer's mode line contains additional information where
the buffer's name is normally displayed: the command interpreter level
and type.
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
- (setq xscheme-process-name (process-name process))
- (setq xscheme-previous-process-state
- (cons (process-filter process)
- (process-sentinel process)))
- (xscheme-process-filter-initialize t)
- (xscheme-modeline-initialize xscheme-buffer-name)
- (set-process-sentinel process 'xscheme-process-sentinel)
- (set-process-filter process 'xscheme-process-filter))
- (setq xscheme-previous-process-state (cons nil nil)))))))
+ (when process
+ (setq-local xscheme-process-name (process-name process))
+ ;; FIXME: Use add-function!
+ (xscheme-process-filter-initialize t)
+ (xscheme-mode-line-initialize xscheme-buffer-name)
+ (add-function :override (process-sentinel process)
+ #'xscheme-process-sentinel)
+ (add-function :override (process-filter process)
+ #'xscheme-process-filter))))))
(scheme-interaction-mode-initialize)
(scheme-mode-variables)
(run-mode-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook))
(defun exit-scheme-interaction-mode ()
- "Take buffer out of 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)
- (let ((process (get-buffer-process (current-buffer))))
- (if process
- (progn
- (if (eq (process-filter process) 'xscheme-process-filter)
- (set-process-filter process (car previous-state)))
- (if (eq (process-sentinel process) 'xscheme-process-sentinel)
- (set-process-sentinel process (cdr previous-state))))))))
+ (funcall xscheme-previous-mode)
+ (let ((process (get-buffer-process (current-buffer))))
+ (when process
+ (remove-function (process-sentinel process) #'xscheme-process-sentinel)
+ (remove-function (process-filter process) #'xscheme-process-filter))))
(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)
+ (setq major-mode 'scheme-interaction-mode) ;FIXME: Use define-derived-mode.
(setq mode-name "Scheme Interaction"))
(defun scheme-interaction-mode-commands (keymap)
(defun xscheme-enter-interaction-mode ()
(with-current-buffer (xscheme-process-buffer)
- (if (not (eq major-mode 'scheme-interaction-mode))
- (if (eq major-mode 'scheme-debugger-mode)
+ (if (not (derived-mode-p 'scheme-interaction-mode))
+ (if (derived-mode-p 'scheme-debugger-mode)
(scheme-interaction-mode-initialize)
(scheme-interaction-mode t)))))
(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)
(interactive)
(xscheme-send-char last-command-event))
-(defun xscheme-enter-debugger-mode (prompt-string)
+(defun xscheme-enter-debugger-mode (_prompt-string)
(with-current-buffer (xscheme-process-buffer)
- (if (not (eq major-mode 'scheme-debugger-mode))
+ (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)))))
(let ((buffer (xscheme-process-buffer)))
(and buffer
(with-current-buffer buffer
- (eq major-mode 'scheme-debugger-mode)))))
+ (derived-mode-p 'scheme-debugger-mode)))))
\f
;;;; Evaluation Commands
(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)
"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)))
xscheme-buffer-name)
(set-marker (process-mark process) (point-max))
(xscheme-process-filter-initialize t)
- (xscheme-modeline-initialize xscheme-buffer-name)
+ (xscheme-mode-line-initialize xscheme-buffer-name)
(set-process-sentinel process 'xscheme-process-sentinel)
(set-process-filter process 'xscheme-process-filter)
(run-hooks 'xscheme-start-hook)))))
(if running-p
(let ((name (buffer-name (current-buffer))))
(setq scheme-mode-line-process '(": " xscheme-runlight-string))
- (xscheme-modeline-initialize name)
+ (xscheme-mode-line-initialize name)
(if (equal name (default-value 'xscheme-buffer-name))
(setq-default xscheme-runlight default-xscheme-runlight))))
(if (or (eq xscheme-runlight default-xscheme-runlight)
(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
(set-buffer (process-buffer process))
(goto-char (process-mark process))))
-(defun xscheme-modeline-initialize (name)
+(defun xscheme-mode-line-initialize (name)
(setq xscheme-runlight-string "")
(if (equal name (default-value 'xscheme-buffer-name))
(setq-default xscheme-runlight-string ""))
(provide 'xscheme)
-;; arch-tag: cfc14adc-2917-409e-ad16-432e8d0017de
;;; xscheme.el ends here
HCoop / bpt / emacs.git / blobdiff