/[slime]/slime/swank-ecl.lisp
ViewVC logotype

Diff of /slime/swank-ecl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by heller, Tue Aug 5 17:38:44 2008 UTC revision 1.25 by heller, Fri Aug 8 13:43:33 2008 UTC
# Line 537  Line 537 
537            ;interrupt-process will halt this if it takes longer than 1sec            ;interrupt-process will halt this if it takes longer than 1sec
538            (sleep 1)))))            (sleep 1)))))
539    
   ;; Auto-flush streams  
   (defvar *auto-flush-interval* 0.15  
     "How often to flush interactive streams. This valu is passed  
     directly to cl:sleep.")  
   
   (defvar *auto-flush-lock* (make-lock :name "auto flush"))  
   
   (defvar *auto-flush-thread* nil)  
   
   (defvar *auto-flush-streams* '())  
   
   (defimplementation make-stream-interactive (stream)  
     (mp:with-lock (*auto-flush-lock*)  
       (pushnew stream *auto-flush-streams*)  
       (unless *auto-flush-thread*  
         (setq *auto-flush-thread*  
               (spawn #'flush-streams  
                      :name "auto-flush-thread")))))  
   
540    (defmethod stream-finish-output ((stream stream))    (defmethod stream-finish-output ((stream stream))
541      (finish-output stream))      (finish-output stream))
542    
   (defun flush-streams ()  
     (loop  
      (mp:with-lock (*auto-flush-lock*)  
        (setq *auto-flush-streams*  
              (remove-if (lambda (x)  
                           (not (and (open-stream-p x)  
                                     (output-stream-p x))))  
                         *auto-flush-streams*))  
        (dolist (i *auto-flush-streams*)  
          (ignore-errors (stream-finish-output i))  
          (ignore-errors (finish-output i))))  
      (sleep *auto-flush-interval*)))  
   
543    )    )
544    

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25

  ViewVC Help
Powered by ViewVC 1.1.5