[slime-cvs] CVS slime

heller heller at common-lisp.net
Fri Sep 14 13:36:23 UTC 2007


Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv20228

Modified Files:
	ChangeLog slime.el 
Log Message:
Some cleanups for the REPL.

* slime.el (slime-repl-write-string): Split it up into smaller
functions.
(slime-repl-emit, slime-repl-emit-result)
(slime-emit-string): New functions.

(slime-repl-save-history): Use prin1 instead of pp.

(repl-type-ahead): New test case.



--- /project/slime/cvsroot/slime/ChangeLog	2007/09/14 12:41:28	1.1215
+++ /project/slime/cvsroot/slime/ChangeLog	2007/09/14 13:36:23	1.1216
@@ -1,3 +1,16 @@
+2007-09-14  Helmut Eller  <heller at common-lisp.net>
+
+	Some cleanups for the REPL.
+
+	* slime.el (slime-repl-write-string): Split it up into smaller
+	functions.
+	(slime-repl-emit, slime-repl-emit-result)
+	(slime-emit-string): New functions.
+
+	(slime-repl-save-history): Use prin1 instead of pp.
+
+	(repl-type-ahead): New test case.
+
 2007-09-12  Christophe Rhodes  <csr21 at cantab.net>
 
 	Make ASDF:LOAD-OP (and SBCL REQUIRE) happy with swank.asd
@@ -14,11 +27,11 @@
 	* swank-sbcl.lisp: Explicitly require ASDF. (While this is not
 	strictly necessary, as it's implicitly loaded on requiring the
 	other modules, I think it's better to be explicit about it.)
-	
+
 2007-09-10  Helmut Eller  <heller at common-lisp.net>
 
 	Fix some bugs introduced while moving doc refs to contrib.
-	
+
 	* swank-sbcl.lisp (condition-references): It's still needed.
 
 	* slime.el (sldb-dispatch-extras): Add missing quote.
@@ -26,7 +39,7 @@
 	contrib/slime-references.el.
 	(slime-cl-symbol-name, slime-cl-symbol-package): Move to
 	contrib/slime-parse.el.
-	
+
 2007-09-10  Helmut Eller  <heller at common-lisp.net>
 
 	Move SBCL doc references to contrib.
--- /project/slime/cvsroot/slime/slime.el	2007/09/10 21:45:17	1.859
+++ /project/slime/cvsroot/slime/slime.el	2007/09/14 13:36:23	1.860
@@ -2833,53 +2833,44 @@
 
 (defun slime-repl-write-string (string &optional target)
   (case target
-    ((nil)                              ; Regular process output
-     (with-current-buffer (slime-output-buffer)
-       (slime-with-output-end-mark
-        (slime-insert-propertized '(face slime-repl-output-face 
-                                         rear-nonsticky (face))
-                                  string)
-        (set-marker slime-output-end (point))
-        (when (and (= (point) slime-repl-prompt-start-mark)
-                   (not (bolp)))
-          (insert "\n")
-          (set-marker slime-output-end (1- (point))))
-        (if (< slime-repl-input-start-mark (point))
-            (set-marker slime-repl-input-start-mark
-                        (point))))))
-    (:repl-result                       
-     (with-current-buffer (slime-output-buffer)
-       (let ((marker (slime-output-target-marker target)))
-         (goto-char marker)
-         (let ((result-start (point)))
-	   (slime-insert-propertized `(face slime-repl-result-face
-                                          rear-nonsticky (face)) 
-                                   string)
-           ;; Move the input-start marker after the REPL result.
-           (set-marker marker (point))))))
-    (t
-     (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)))))))))
+    ((nil) (slime-repl-emit string))
+    (:repl-result (slime-repl-emit-result string))
+    (t (slime-emit-string string target))))
+
+(defun slime-repl-emit (string)
+  ;; insert the string STRING in the output buffer
+  (with-current-buffer (slime-output-buffer)
+    (slime-with-output-end-mark 
+     (slime-insert-propertized '(face slime-repl-output-face
+                                      rear-nonsticky (face))
+                               string)
+     (set-marker slime-output-end (point))
+     (when (and (= (point) slime-repl-prompt-start-mark)
+                (not (bolp)))
+       (insert "\n")
+       (set-marker slime-output-end (1- (point))))
+     (when (< slime-repl-input-start-mark (point))
+       (set-marker slime-repl-input-start-mark (point))))))
+
+(defun slime-repl-emit-result (string)
+  ;; insert STRING and mark it as evaluation result
+  (with-current-buffer (slime-output-buffer)
+    (goto-char slime-repl-input-start-mark)
+    (slime-insert-propertized `(face slime-repl-result-face
+                                     rear-nonsticky (face)) 
+                              string)
+    (set-marker slime-repl-input-start-mark (point))))
 
 (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 that indicate where
-output should be inserted.")
+  "Map from TARGET ids to Emacs markers.
+The markers indicate where output should be inserted.")
 
 (defun slime-output-target-marker (target)
-  "Return a marker that indicates where output for TARGET should
-be inserted."
+  "Return the marker where output for TARGET should be inserted."
   (case target
     ((nil)
      (with-current-buffer (slime-output-buffer)
@@ -2890,6 +2881,20 @@
     (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 (&optional connection)
   "Select the output buffer, preferably in a different window."
   (interactive (list (if prefix-arg (slime-choose-connection))))
@@ -3653,12 +3658,13 @@
     (let ((hist (subseq hist 0 (min (length hist) slime-repl-history-size))))
       ;;(message "saving %s to %s\n" hist file)
       (with-temp-file file
-        (let ((cs slime-repl-history-file-coding-system))
+        (let ((cs slime-repl-history-file-coding-system)
+              (print-length nil) (print-level nil))
           (setq buffer-file-coding-system cs)
-          (insert (format ";; -*- coding: %s -*-\n" cs)))
-        (insert ";; History for SLIME REPL. Automatically written.\n"
-                ";; Edit only if you know what you're doing\n")
-        (pp (mapcar #'substring-no-properties hist) (current-buffer))))))
+          (insert (format ";; -*- coding: %s -*-\n" cs))
+          (insert ";; History for SLIME REPL. Automatically written.\n"
+                  ";; Edit only if you know what you're doing\n")
+          (prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))))
 
 (defun slime-repl-save-all-histories ()
   "Save the history in each repl buffer."
@@ -8862,6 +8868,24 @@
     (slime-check "Buffer contains result"
       (equal final-contents (buffer-string)))))
 
+(def-slime-test repl-type-ahead
+    (command input final-contents)
+    "Ensure that user input is preserved correctly.
+In particular, input inserted while waiting for a result."
+    '(("(sleep 1)" "foo" "SWANK> (sleep 1)
+NIL
+SWANK> foo"))
+  (when (slime-output-buffer)
+    (kill-buffer (slime-output-buffer)))
+  (setf (slime-lisp-package-prompt-string) "SWANK")
+  (with-current-buffer (slime-output-buffer)
+    (insert command)
+    (call-interactively 'slime-repl-return)
+    (insert input)
+    (slime-sync-to-top-level 5)
+    (slime-check "Buffer contains result"
+      (equal final-contents (buffer-string)))))
+
 (def-slime-test interactive-eval-output
     (input result-contents visiblep)
     "Test simple commands in the minibuffer."
@@ -9407,8 +9431,9 @@
 
 (defvar slime-obsolete-commands 
   '(("\C-c\M-i" (slime repl) slime-fuzzy-complete-symbol)
-    ("\M-\C-a" (slime) slime-beginning-of-defun)
-    ("\M-\C-e" (slime) slime-end-of-defun)
+    ;; Don't shadow bindings in lisp-mode-map
+    ;;("\M-\C-a" (slime) slime-beginning-of-defun)
+    ;;("\M-\C-e" (slime) slime-end-of-defun)
     ("\C-c\M-q" (slime) slime-reindent-defun)
     ("\C-c\C-s" (slime) slime-complete-form)
     ;; (nil nil slime-close-all-parens-in-sexp)




More information about the slime-cvs mailing list