Create a gist now

Instantly share code, notes, and snippets.

(in-package "SB-THREAD")
(define-alien-routine ("SetConsoleCtrlHandler" set-console-ctrl-handler) int
(callback (function (:stdcall int) int))
(enable int))
(defun windows-console-control-handler (event-code)
(case event-code
(flet ((interrupt-it ()
(let ((int (make-condition 'interactive-interrupt
:address "...Who knows?")))
;; First SIGNAL, so that handlers can run.
(signal int)
(%break 'sigint int)))))
(interrupt-thread (foreground-thread) #'interrupt-it)
(defvar *console-control-handler* #'windows-console-control-handler)
(defvar *console-control-enabled* nil)
(defvar *console-control-spec* nil)
(sb-alien::define-alien-callback alien-console-control-handler (:stdcall int)
((event-code int))
(if (ignore-errors (funcall *console-control-handler* event-code)) 1 0))
(defun console-control-handler ()
"Get or set windows console control handler.
Boolean value: use default handler (NIL) or ignore event (T). Symbol
or function: designator for a function that receives an event code and
returns generalized boolean (false to fall back to other handlers,
true to stop searching)." *console-control-spec*)
(defun (setf console-control-handler) (new-handler)
(etypecase new-handler
(aver (plusp (set-console-ctrl-handler
(sap-alien (int-sap 0)
(function (:stdcall int) int))
(if new-handler 1 0))))
(setf *console-control-enabled* nil))
((or symbol function)
(setf *console-control-handler* new-handler)
(aver (plusp (set-console-ctrl-handler alien-console-control-handler 1)))))
(setf *console-control-spec* new-handler))
(defun initialize-console-control-handler (&optional reset-to-default-p)
(setf (console-control-handler)
(if reset-to-default-p
(initialize-console-control-handler t)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment