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

Diff of /slime/swank-lispworks.lisp

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

revision 1.104 by heller, Mon Aug 4 21:38:07 2008 UTC revision 1.105 by heller, Tue Aug 5 17:38:59 2008 UTC
# Line 795  function names like \(SETF GET)." Line 795  function names like \(SETF GET)."
795      (defmethod env-internals:environment-display-debugger (env)      (defmethod env-internals:environment-display-debugger (env)
796        *debug-io*)))        *debug-io*)))
797    
798    (defvar *auto-flush-interval* 0.15)
799    (defvar *auto-flush-lock* (mp:make-lock :name "auto-flush-lock"))
800    (defvar *auto-flush-thread* nil)
801    (defvar *auto-flush-streams* '())
802    
803  (defimplementation make-stream-interactive (stream)  (defimplementation make-stream-interactive (stream)
804    (unless (find-method #'stream:stream-soft-force-output nil `((eql ,stream))    (mp:with-lock (*auto-flush-lock*)
805                         nil)      (pushnew stream *auto-flush-streams*)
806      (let ((lw:*handle-warn-on-redefinition* :warn))      (unless *auto-flush-thread*
807        (defmethod stream:stream-soft-force-output  ((o (eql stream)))        (setq *auto-flush-thread*
808          (force-output o)))))              (mp:process-run-function "auto-flush-thread [SWANK]" ()
809                                         #'flush-streams)))))
810    
811    (defun flush-streams ()
812      (loop
813       (mp:with-lock (*auto-flush-lock*)
814         (setq *auto-flush-streams*
815               (remove-if (lambda (x)
816                            (not (and (open-stream-p x)
817                                      (output-stream-p x))))
818                          *auto-flush-streams*))
819         (mapc #'finish-output *auto-flush-streams*))
820       (sleep *auto-flush-interval*)))
821    
822  (defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args)  (defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args)
823    (apply (swank-sym :y-or-n-p-in-emacs) msg args))    (apply (swank-sym :y-or-n-p-in-emacs) msg args))

Legend:
Removed from v.1.104  
changed lines
  Added in v.1.105

  ViewVC Help
Powered by ViewVC 1.1.5