Changeset 6774

Timestamp:

Jun 20, 2007, 11:34:00 AM (17 years ago)

Author:

Gary Byers

Message:

with-popop-display forces output.

File:

• branches/ide-1.0/ccl/hemlock/src/macros.lisp (modified) (2 diffs)

branches/ide-1.0/ccl/hemlock/src/macros.lisp

@@ -560 +560 @@
   (when (and (numberp height) (zerop height))
     (editor-error "I doubt that you really want a window with no height"))
-  (let ((cleanup-p (gensym))
-        (stream (gensym)))
+  (let ((stream (gensym)))
     `(let ()
        (let ((,stream (ccl::typeout-stream)))
-       (ccl::stream-clear-output (ccl::typeout-stream))
+         (clear-output ,stream)
        (unwind-protect
            (progn
              (catch 'more-punt
                (let ((,var ,stream))
-                 ;; GB ,@decls
-                 (multiple-value-prog1
-                     (locally ,@body))))))))))
+                 ,@body)))
+         (force-output ,stream))))))
 
 
@@ -578 +576 @@
 (defvar *random-typeout-buffers* () "A list of random-typeout buffers.")
 
-(defun get-random-typeout-info (buffer-name line-buffered-p)
-  (let* ((buffer (getstring buffer-name *buffer-names*))
-         (stream
-          (cond
-           ((not buffer)
-            (let* ((buf (make-buffer
-                         buffer-name
-                         :modes '("Fundamental")
-                         :modeline-fields *random-typeout-ml-fields*
-                         :delete-hook
-                         (list #'(lambda (buffer)
-                                   (setq *random-typeout-buffers*
-                                         (delete buffer *random-typeout-buffers*
-                                                 :key #'car))))))
-                   (point (buffer-point buf))
-                   (stream (make-random-typeout-stream
-                            (copy-mark point :left-inserting))))
-              (setf (random-typeout-stream-more-mark stream)
-                    (copy-mark point :right-inserting))
-              (push (cons buf stream) *random-typeout-buffers*)
-              stream))
-           ((member buffer *random-typeout-buffers* :key #'car)
-            (delete-region (buffer-region buffer))
-            (let* ((pair (assoc buffer *random-typeout-buffers*))
-                   (stream (cdr pair)))
-              (setf *random-typeout-buffers*
-                    (cons pair (delete pair *random-typeout-buffers*)))
-              (setf (random-typeout-stream-first-more-p stream) t)
-              (setf (random-typeout-stream-no-prompt stream) nil)
-              stream))
-           (t
-            (error "~A is not a random typeout buffer."
-                   (buffer-name buffer))))))
-    (setf (slot-value stream 'line-buffered-p)
-          line-buffered-p)
-    stream))
+