[slime-cvs] CVS slime/contrib
CVS User heller
heller at common-lisp.net
Wed Dec 24 08:07:03 UTC 2008
Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv20387/contrib
Added Files:
slime-repl.el
Log Message:
Move most of the REPL mode to contrib.
Disable some commands that depend on the
existence of a REPL buffer.
--- /project/slime/cvsroot/slime/contrib/slime-repl.el 2008/12/24 08:07:03 NONE
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el 2008/12/24 08:07:03 1.1
;;;;; slime-repl
(defgroup slime-repl nil
"The Read-Eval-Print Loop (*slime-repl* buffer)."
:prefix "slime-repl-"
:group 'slime)
(defcustom slime-repl-shortcut-dispatch-char ?\,
"Character used to distinguish repl commands from lisp forms."
:type '(character)
:group 'slime-repl)
(defcustom slime-repl-only-save-lisp-buffers t
"When T we only attempt to save lisp-mode file buffers. When
NIL slime will attempt to save all buffers (as per
save-some-buffers). This applies to all ASDF related repl
shortcuts."
:type '(boolean)
:group 'slime-repl)
(defface slime-repl-prompt-face
(if (slime-face-inheritance-possible-p)
'((t (:inherit font-lock-keyword-face)))
'((((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
(t (:weight bold))))
"Face for the prompt in the SLIME REPL."
:group 'slime-repl)
(defface slime-repl-output-face
(if (slime-face-inheritance-possible-p)
'((t (:inherit font-lock-string-face)))
'((((class color) (background light)) (:foreground "RosyBrown"))
(((class color) (background dark)) (:foreground "LightSalmon"))
(t (:slant italic))))
"Face for Lisp output in the SLIME REPL."
:group 'slime-repl)
(defface slime-repl-input-face
'((t (:bold t)))
"Face for previous input in the SLIME REPL."
:group 'slime-repl)
(defface slime-repl-result-face
'((t ()))
"Face for the result of an evaluation in the SLIME REPL."
:group 'slime-repl)
(defcustom slime-repl-history-file "~/.slime-history.eld"
"File to save the persistent REPL history to."
:type 'string
:group 'slime-repl)
(defcustom slime-repl-history-size 200
"*Maximum number of lines for persistent REPL history."
:type 'integer
:group 'slime-repl)
(defcustom slime-repl-history-file-coding-system
(cond ((slime-find-coding-system 'utf-8-unix) 'utf-8-unix)
(t slime-net-coding-system))
"*The coding system for the history file."
:type 'symbol
:group 'slime-repl)
;; dummy defvar for compiler
(defvar slime-repl-read-mode)
(defun slime-reading-p ()
"True if Lisp is currently reading input from the REPL."
(with-current-buffer (slime-output-buffer)
slime-repl-read-mode))
;;;; Stream output
(slime-def-connection-var slime-connection-output-buffer nil
"The buffer for the REPL. May be nil or a dead buffer.")
(make-variable-buffer-local
(defvar slime-output-start nil
"Marker for the start of the output for the evaluation."))
(make-variable-buffer-local
(defvar slime-output-end nil
"Marker for end of output. New output is inserted at this mark."))
;; dummy definitions for the compiler
(defvar slime-repl-package-stack)
(defvar slime-repl-directory-stack)
(defvar slime-repl-input-start-mark)
(defvar slime-repl-prompt-start-mark)
(defun slime-output-buffer (&optional noprompt)
"Return the output buffer, create it if necessary."
(let ((buffer (slime-connection-output-buffer)))
(or (if (buffer-live-p buffer) buffer)
(setf (slime-connection-output-buffer)
(let ((connection (slime-connection)))
(with-current-buffer (slime-repl-buffer t connection)
(unless (eq major-mode 'slime-repl-mode)
(slime-repl-mode))
(setq slime-buffer-connection connection)
(slime-reset-repl-markers)
(unless noprompt
(slime-repl-insert-prompt))
(current-buffer)))))))
(defvar slime-repl-banner-function 'slime-repl-insert-banner)
(defun slime-repl-update-banner ()
(funcall slime-repl-banner-function)
(goto-char (point-max))
(slime-mark-output-start)
(slime-mark-input-start)
(slime-repl-insert-prompt))
(defun slime-repl-insert-banner ()
(when (zerop (buffer-size))
(let ((welcome (concat "; SLIME " (or (slime-changelog-date)
"- ChangeLog file not found"))))
(insert welcome))))
(defun slime-init-output-buffer (connection)
(with-current-buffer (slime-output-buffer t)
(setq slime-buffer-connection connection
slime-repl-directory-stack '()
slime-repl-package-stack '())
(slime-repl-update-banner)))
(defun slime-display-output-buffer ()
"Display the output buffer and scroll to bottom."
(with-current-buffer (slime-output-buffer)
(goto-char (point-max))
(unless (get-buffer-window (current-buffer) t)
(display-buffer (current-buffer) t))
(slime-repl-show-maximum-output)))
(defmacro slime-with-output-end-mark (&rest body)
"Execute BODY at `slime-output-end'.
If point is initially at `slime-output-end' and the buffer is visible
update window-point afterwards. If point is initially not at
`slime-output-end, execute body inside a `save-excursion' block."
`(let ((body.. (lambda () , at body))
(updatep.. (and (eobp) (pos-visible-in-window-p))))
(cond ((= (point) slime-output-end)
(let ((start.. (point)))
(funcall body..)
(set-marker slime-output-end (point))
(when (= start.. slime-repl-input-start-mark)
(set-marker slime-repl-input-start-mark (point)))))
(t
(save-excursion
(goto-char slime-output-end)
(funcall body..))))
(when updatep..
(slime-repl-show-maximum-output))))
(defun slime-output-filter (process string)
(with-current-buffer (process-buffer process)
(when (and (plusp (length string))
(eq (process-status slime-buffer-connection) 'open))
(slime-write-string string))))
(defvar slime-open-stream-hooks)
(defun slime-open-stream-to-lisp (port)
(let ((stream (open-network-stream "*lisp-output-stream*"
(slime-with-connection-buffer ()
(current-buffer))
slime-lisp-host port)))
(slime-set-query-on-exit-flag stream)
(set-process-filter stream 'slime-output-filter)
(let ((pcs (process-coding-system (slime-current-connection))))
(set-process-coding-system stream (car pcs) (cdr pcs)))
(when-let (secret (slime-secret))
(slime-net-send secret stream))
(run-hook-with-args 'slime-open-stream-hooks stream)
stream))
(defun slime-io-speed-test (&optional profile)
"A simple minded benchmark for stream performance.
If a prefix argument is given, instrument the slime package for
profiling before running the benchmark."
(interactive "P")
(eval-and-compile
(require 'elp))
(elp-reset-all)
(elp-restore-all)
(load "slime.el")
;;(byte-compile-file "slime-net.el" t)
;;(setq slime-log-events nil)
(setq slime-enable-evaluate-in-emacs t)
;;(setq slime-repl-enable-presentations nil)
(when profile
(elp-instrument-package "slime-"))
(kill-buffer (slime-output-buffer))
(switch-to-buffer (slime-output-buffer))
(delete-other-windows)
(sit-for 0)
(slime-repl-send-string "(swank:io-speed-test 4000 1)")
(let ((proc (slime-inferior-process)))
(when proc
(display-buffer (process-buffer proc) t)
(goto-char (point-max)))))
(defvar slime-write-string-function 'slime-repl-write-string)
(defun slime-write-string (string &optional target)
"Insert STRING in the REPL buffer or some other TARGET.
If TARGET is nil, insert STRING as regular process
output. If TARGET is :repl-result, insert STRING as the result of the
evaluation. Other values of TARGET map to an Emacs marker via the
hashtable `slime-output-target-to-marker'; output is inserted at this marker."
(funcall slime-write-string-function string target))
(defun slime-repl-write-string (string &optional target)
(case target
((nil) (slime-repl-emit string))
(:repl-result (slime-repl-emit-result string))
(t (slime-emit-string string target))))
(defvar slime-repl-popup-on-output nil
"Display the output buffer when some output is written.
This is set to nil after displaying the buffer.")
(defmacro slime-save-marker (marker &rest body)
(let ((pos (gensym "pos")))
`(let ((,pos (marker-position ,marker)))
(prog1 (progn . ,body)
(set-marker ,marker ,pos)))))
(put 'slime-save-marker 'lisp-indent-function 1)
(defun slime-repl-emit (string)
;; insert the string STRING in the output buffer
(with-current-buffer (slime-output-buffer)
(save-excursion
(goto-char slime-output-end)
(slime-save-marker slime-output-start
(slime-propertize-region '(face slime-repl-output-face
rear-nonsticky (face))
(insert-before-markers string)
(when (and (= (point) slime-repl-prompt-start-mark)
(not (bolp)))
(insert-before-markers "\n")
(set-marker slime-output-end (1- (point)))))))
(when slime-repl-popup-on-output
(setq slime-repl-popup-on-output nil)
(display-buffer (current-buffer)))
(slime-repl-show-maximum-output)))
(defun slime-repl-emit-result (string &optional bol)
;; insert STRING and mark it as evaluation result
(with-current-buffer (slime-output-buffer)
(save-excursion
(slime-save-marker slime-output-start
(slime-save-marker slime-output-end
(goto-char slime-repl-input-start-mark)
(when (and bol (not (bolp))) (insert-before-markers "\n"))
(slime-propertize-region `(face slime-repl-result-face
rear-nonsticky (face))
(insert-before-markers string)))))
(slime-repl-show-maximum-output)))
(defvar slime-last-output-target-id 0
"The last integer we used as a TARGET id.")
(defvar slime-output-target-to-marker
(make-hash-table)
"Map from TARGET ids to Emacs markers.
The markers indicate where output should be inserted.")
(defun slime-output-target-marker (target)
"Return the marker where output for TARGET should be inserted."
(case target
((nil)
(with-current-buffer (slime-output-buffer)
slime-output-end))
(:repl-result
(with-current-buffer (slime-output-buffer)
slime-repl-input-start-mark))
(t
(gethash target slime-output-target-to-marker))))
(defun slime-emit-string (string target)
"Insert STRING at target TARGET.
See `slime-output-target-to-marker'."
(let* ((marker (slime-output-target-marker target))
(buffer (and marker (marker-buffer marker))))
(when buffer
(with-current-buffer buffer
(save-excursion
;; Insert STRING at MARKER, then move MARKER behind
;; the insertion.
(goto-char marker)
(insert-before-markers string)
(set-marker marker (point)))))))
(defun slime-switch-to-output-buffer ()
"Select the output buffer, when possible in an existing window.
Hint: You can use `display-buffer-reuse-frames' and
`special-display-buffer-names' to customize the frame in which
the buffer should appear."
(interactive)
(slime-pop-to-buffer (slime-output-buffer))
(goto-char (point-max)))
;;;; REPL
;;
;; The REPL uses some markers to separate input from output. The
;; usual configuration is as follows:
;;
;; ... output ... ... result ... prompt> ... input ...
;; ^ ^ ^ ^ ^
;; output-start output-end prompt-start input-start point-max
;;
;; input-start is a right inserting marker, because
;; we want it to stay behind when the user inserts text.
;;
;; We maintain the following invariant:
;;
;; output-start <= output-end <= input-start.
;;
;; This invariant is important, because we must be prepared for
;; asynchronous output and asynchronous reads. ("Asynchronous" means,
;; triggered by Lisp and not by Emacs.)
;;
;; All output is inserted at the output-end marker. Some care must be
;; taken when output-end and input-start are at the same position: if
;; we insert at that point, we must move the right markers. We should
;; also not leave (window-)point in the middle of the new output. The
;; idiom we use is a combination to slime-save-marker,
;; insert-before-markers, and manually updating window-point
;; afterwards.
;;
;; A "synchronous" evaluation request proceeds as follows: the user
;; inserts some text between input-start and point-max and then hits
;; return. We send that region to Lisp, move the output and input
;; makers to the line after the input and wait. When we receive the
;; result, we insert it together with a prompt between the output-end
;; and input-start mark. See `slime-repl-insert-prompt'.
;;
;; It is possible that some output for such an evaluation request
;; arrives after the result. This output is inserted before the
;; result (and before the prompt).
;;
;; If we are in "reading" state, e.g., during a call to Y-OR-N-P,
;; there is no prompt between output-end and input-start.
;;
(slime-make-variables-buffer-local
(defvar slime-repl-package-stack nil
"The stack of packages visited in this repl.")
(defvar slime-repl-directory-stack nil
"The stack of default directories associated with this repl.")
(defvar slime-repl-prompt-start-mark)
(defvar slime-repl-input-start-mark)
(defvar slime-repl-old-input-counter 0
"Counter used to generate unique `slime-repl-old-input' properties.
This property value must be unique to avoid having adjacent inputs be
joined together."))
(defun slime-reset-repl-markers ()
(dolist (markname '(slime-output-start
slime-output-end
slime-repl-prompt-start-mark
slime-repl-input-start-mark))
(set markname (make-marker))
(set-marker (symbol-value markname) (point))))
;;;;; REPL mode setup
(defvar slime-repl-mode-map)
(setq slime-repl-mode-map (make-sparse-keymap))
(set-keymap-parent slime-repl-mode-map lisp-mode-map)
(dolist (spec slime-keys)
(destructuring-bind (key command &key inferior prefixed
&allow-other-keys) spec
(when inferior
(let ((key (if prefixed (concat slime-prefix-key key) key)))
(define-key slime-repl-mode-map key command)))))
(slime-define-keys slime-repl-mode-map
("\C-m" 'slime-repl-return)
([return] 'slime-repl-return)
("\C-j" 'slime-repl-newline-and-indent)
("\C-\M-m" 'slime-repl-closing-return)
([(control return)] 'slime-repl-closing-return)
("\C-a" 'slime-repl-bol)
([home] 'slime-repl-bol)
[1331 lines skipped]
More information about the slime-cvs
mailing list