784
784
(defun emacs-buffer-source-location (code-location plist)
785
785
(if (code-location-has-debug-block-info-p code-location)
786
(destructuring-bind (&key emacs-buffer emacs-position emacs-string) plist
786
(destructuring-bind (&key emacs-buffer emacs-position emacs-string
787
789
(let* ((pos (string-source-position code-location emacs-string))
788
790
(snipped (with-input-from-string (s emacs-string)
789
791
(read-snippet s pos))))
1194
;;; Auto-flush streams
1196
;; XXX race conditions
1196
;; Auto-flush streams
1198
(defvar *auto-flush-interval* 0.15
1199
"How often to flush interactive streams. This valu is passed
1200
directly to cl:sleep.")
1202
(defvar *auto-flush-lock* (make-recursive-lock :name "auto flush"))
1204
(defvar *auto-flush-thread* nil)
1197
1206
(defvar *auto-flush-streams* '())
1199
(defvar *auto-flush-thread* nil)
1201
1208
(defimplementation make-stream-interactive (stream)
1202
(setq *auto-flush-streams* (adjoin stream *auto-flush-streams*))
1203
(unless *auto-flush-thread*
1204
(setq *auto-flush-thread*
1205
(sb-thread:make-thread #'flush-streams
1206
:name "auto-flush-thread"))))
1209
(call-with-recursive-lock-held
1212
(pushnew stream *auto-flush-streams*)
1213
(unless *auto-flush-thread*
1214
(setq *auto-flush-thread*
1215
(sb-thread:make-thread #'flush-streams
1216
:name "auto-flush-thread"))))))
1208
1218
(defun flush-streams ()
1210
(setq *auto-flush-streams*
1211
(remove-if (lambda (x)
1212
(not (and (open-stream-p x)
1213
(output-stream-p x))))
1214
*auto-flush-streams*))
1215
(mapc #'finish-output *auto-flush-streams*)
1220
(call-with-recursive-lock-held
1223
(setq *auto-flush-streams*
1224
(remove-if (lambda (x)
1225
(not (and (open-stream-p x)
1226
(output-stream-p x))))
1227
*auto-flush-streams*))
1228
(mapc #'finish-output *auto-flush-streams*)))
1229
(sleep *auto-flush-interval*)))