[Ctrl+v]code

Author: smokeink. Date 2019-12-14 13:31:52, views: 61, Raw

(in-package :sb-thread)
 
(defun release-foreground% (thread &optional next)
  "Background thread.  If NEXT is supplied, arrange for it to have the foreground next."
  #-sb-thread (declare (ignore next))
  #-sb-thread nil
  #+sb-thread
  (let ((session *session*))
    (with-session-lock (session)
      (symbol-macrolet
          ((interactive-threads (session-interactive-threads session)))
        (setf interactive-threads
              (delete thread interactive-threads))
        (when (and next (thread-alive-p next))
          (setf interactive-threads
                (list* next (delete next interactive-threads))))
        (condition-broadcast (session-interactive-threads-queue session))))))
 
(defun release-foreground (&optional next)
 (release-foreground% *current-thread* next))
 
 
(in-package :cl-user)
 
  ;; Useful when developing multi-threaded apps in the console (without slime)
  (defun current-thread-to-fg ()
    (sb-thread::release-foreground2
      (sb-thread::main-thread) (bt:current-thread)))
 
  (defmacro fbreak (&rest args)
    "Foreground Break. Needed because
     (break) bypasses error handling so with-fg-debugger has no effect
     if you need to (break) inside the thread."
    `(progn
       (current-thread-to-fg)
       (break ,@args)))
 
  (defmacro with-fg-debugger (&body body)
    "Brings the current thread to foreground before invoking the debugger.
     Useful in case errors happen inside body."
    `(handler-case
      (progn ,@body)
      (condition (c)
                 (current-thread-to-fg)
                 (invoke-debugger  c)))))