~ubuntu-branches/ubuntu/trusty/slime/trusty

« back to all changes in this revision

Viewing changes to swank-sbcl.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2007-05-31 22:55:16 UTC
  • Revision ID: james.westby@ubuntu.com-20070531225516-xj7qt68nri0vd5ig
Tags: 1:20070409-2
* Fixed texlive build-dependency (Closes: #425436)
* Fixed autostart under emacs (Closes: #425435)
* New upstream. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
783
783
 
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
                                &allow-other-keys)
 
788
          plist
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))))
1191
1193
                                              mutex))))))))
1192
1194
 
1193
1195
 
1194
 
;;; Auto-flush streams
1195
 
 
1196
 
  ;; XXX race conditions
 
1196
  ;; Auto-flush streams
 
1197
 
 
1198
  (defvar *auto-flush-interval* 0.15
 
1199
    "How often to flush interactive streams. This valu is passed
 
1200
    directly to cl:sleep.")
 
1201
 
 
1202
  (defvar *auto-flush-lock* (make-recursive-lock :name "auto flush"))
 
1203
 
 
1204
  (defvar *auto-flush-thread* nil)
 
1205
 
1197
1206
  (defvar *auto-flush-streams* '())
1198
 
 
1199
 
  (defvar *auto-flush-thread* nil)
1200
 
 
 
1207
  
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
 
1210
     *auto-flush-lock*
 
1211
     (lambda ()
 
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"))))))
1207
1217
 
1208
1218
  (defun flush-streams ()
1209
1219
    (loop
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*)
1216
 
     (sleep 0.15)))
 
1220
     (call-with-recursive-lock-held
 
1221
      *auto-flush-lock*
 
1222
      (lambda ()
 
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*)))
1217
1230
 
1218
1231
  )
1219
1232