Created
March 7, 2012 22:20
-
-
Save laynor/1996644 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defun stumpwm-internal-loop () | |
"The internal loop that waits for events and handles them." | |
(loop | |
(run-hook *internal-loop-hook*) | |
(handler-bind | |
((xlib:lookup-error (lambda (c) | |
(if (lookup-error-recoverable-p) | |
(recover-from-lookup-error) | |
(error c)))) | |
(warning #'muffle-warning) | |
((or serious-condition error) | |
(lambda (c) | |
(run-hook *top-level-error-hook*) | |
(perform-top-level-error-action c))) | |
(t | |
(lambda (c) | |
;; some other wacko condition was raised so first try | |
;; what we can to keep going. | |
(cond ((find-restart 'muffle-warning) | |
(muffle-warning)) | |
((find-restart 'continue) | |
(continue))) | |
;; and if that fails treat it like a top level error. | |
(perform-top-level-error-action c)))) | |
;; ;; Note: process-event appears to hang for an unknown | |
;; ;; reason. This is why it is passed a timeout in hopes that | |
;; ;; this will keep it from hanging. | |
;; (let ((timeout (get-next-timeout *timer-list*))) | |
;; (dformat 10 "timeout: ~a~%" timeout) | |
;; (if timeout | |
;; (let* ((nevents (xlib:event-listen *display* (ceiling timeout)))) | |
;; (setf *timer-list* (run-expired-timers *timer-list*)) | |
;; (when nevents | |
;; (xlib:process-event *display* :handler #'handle-event))) | |
;; ;; Otherwise, simply wait for an event | |
;; (xlib:process-event *display* :handler #'handle-event)) | |
;; ;; flush any pending output. You'd think process-event would, but | |
;; ;; it seems not. | |
;; (xlib:display-finish-output *display*) | |
;; ;;(dformat 10 "toplevel focus: ~a~%" (multiple-value-list (xlib:input-focus *display*))) | |
;; ) | |
(xlib:display-finish-output *display*) | |
(let* ((to (get-next-timeout *timer-list*)) | |
(timeout (and to (ceiling to))) | |
(nevents (xlib:event-listen *display* timeout))) | |
(dformat 10 "timeout: ~a~%" timeout) | |
(when timeout | |
(setf *timer-list* (run-expired-timers *timer-list*))) | |
(xlib:with-event-queue (*display*) | |
(when nevents | |
(run-hook *event-processing-hook*) | |
(xlib:process-event *display* :handler #'handle-event :timeout 0)))) | |
))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment