;; --------- ;; ;; main loop ;; ;; --------- ;; (defun main-loop (disp isend? (win nil)) (loop (event-case (disp) (:exposure (event-window count) (and (0= count) (handle-exposure event-window)) t) (:button-press (event-window code x y) (handle-button-press event-window code x y) t) (:enter-notify (event-window) (handle-enter-notify event-window) t) (:leave-notify (event-window) (handle-leave-notify event-window) t) (:motion-notify (event-window x y) (and (eq event-window win) (handle-motion-notify event-window x y)) t) (otherwise t)) (cond ((funcall isend?) (exit))))) ;; ---------- ;; ;; local loop ;; ;; ---------- ;; (defun loop-disable-other-win (win isend?) (if (not (listp win)) (setq win (ncons win))) (let ((disp (window-display (car win)))) (loop (event-case (disp) (:exposure (event-window count) (and (0= count) (handle-exposure event-window)) t) (:button-press (event-window code x y) (and (memq event-window win) (handle-button-press event-window code x y)) t) (:button-release (event-window code x y) (and (memq event-window win) (handle-button-release event-window code x y)) t) (:motion-notify (event-window x y) (and (memq event-window win) (handle-motion-notify event-window x y)) t) (:enter-notify (event-window) (and (memq event-window win) (handle-enter-notify event-window)) t) (:leave-notify (event-window) (and (memq event-window win) (handle-leave-notify event-window)) t) (otherwise t)) (cond ((funcall isend?) (exit))))))