Browse code

Modified (prompt...) to show the current package, as a nickname if possible, unless a specific prompt is requested. Also, changed the output stream to force the buffer to output if there is a delay of 1/5 of a second. This makes quickload and other functions that take time and print dots on the screen work. The combined effect of these small changes is that the user experience is much closer to slime.

stacksmith authored on 2016-12-29 04:42:03 • dherring committed on 2017-12-10 16:31:26
Showing 1 changed files
... ...
@@ -375,8 +375,12 @@
375 375
      :accessor output-buffer
376 376
      :initform "")
377 377
    (index
378
-     :accessor index
379
-     :initform -1))
378
+    :accessor index
379
+    :initform -1)
380
+   (wrstamp
381
+    :accessor wrstamp
382
+    :initform 0))
383
+  
380 384
   (:documentation "Provides a bi-directional stream to act as a conduit
381 385
     for the user input and output in the listener. Typically bind an
382 386
     instance of this to all interesting streams during evaluation."))
... ...
@@ -444,9 +448,14 @@
444 448
   "Buffer 100 characters of output to reduce calls across the sub-process to Tk"
445 449
   (setf (output-buffer user-stream)
446 450
     (format nil "~A~A" (output-buffer
447
-                         user-stream) string))
448
-  (when (> (length (output-buffer user-stream)) 100)
449
-    (flush user-stream)))
451
+			user-stream) string))
452
+  (let* ((timestamp (get-internal-real-time))
453
+	 (elapsed (- timestamp (wrstamp user-stream))))
454
+    (when (or (> elapsed 200;internal-time-units-per-second
455
+		 )
456
+	      (> (length (output-buffer user-stream)) 100))
457
+      (flush user-stream)
458
+      (setf (wrstamp user-stream) timestamp))))
450 459
 
451 460
 (defmethod flush ((user-stream user-stream))
452 461
   (output *listener* (output-buffer user-stream))
... ...
@@ -813,12 +822,18 @@
813 822
       (command-history listener) 0))
814 823
   (prompt listener))
815 824
 
816
-(defmethod prompt ((listener listener) &key (prompt ">") (clear nil))
825
+(defun prompt1 (prompt)
826
+  (if prompt
827
+      (format nil "~%~a" prompt)
828
+      (format nil "~%~a> " (or (first (package-nicknames *package*))
829
+			       (package-name *package*)))))
830
+
831
+(defmethod prompt ((listener listener) &key prompt (clear nil))
817 832
   (when clear
818 833
     (let ((start-of-line (text-row-add (repl-insert-point listener) 0)))
819 834
       (ltk::delete-text (inferior-win listener) start-of-line "end")
820 835
       (setf (repl-insert-point listener) (ltk::get-cursor-pos (inferior-win listener)))))
821
-  (output listener (format nil "~%~a " prompt) "prompt"))
836
+  (output listener (prompt1 prompt) "prompt"))
822 837
 
823 838
 (defmethod get-user-input ((listener listener))
824 839
   (trim-code (ltk::get-text-range (inferior-win listener)