Revision Log
Revision: 1.1 - (view) (download)
| 1 : | ktanaka | 1.1 | ;; --------- ;; |
| 2 : | ;; main loop ;; | ||
| 3 : | ;; --------- ;; | ||
| 4 : | (defun main-loop (disp isend? (win nil)) | ||
| 5 : | (loop | ||
| 6 : | (event-case (disp) | ||
| 7 : | (:exposure | ||
| 8 : | (event-window count) | ||
| 9 : | (and (0= count) (handle-exposure event-window)) | ||
| 10 : | t) | ||
| 11 : | (:button-press | ||
| 12 : | (event-window code x y) | ||
| 13 : | (handle-button-press event-window code x y) | ||
| 14 : | t) | ||
| 15 : | (:enter-notify | ||
| 16 : | (event-window) | ||
| 17 : | (handle-enter-notify event-window) | ||
| 18 : | t) | ||
| 19 : | (:leave-notify | ||
| 20 : | (event-window) | ||
| 21 : | (handle-leave-notify event-window) | ||
| 22 : | t) | ||
| 23 : | (:motion-notify | ||
| 24 : | (event-window x y) | ||
| 25 : | (and (eq event-window win) | ||
| 26 : | (handle-motion-notify event-window x y)) | ||
| 27 : | t) | ||
| 28 : | (otherwise | ||
| 29 : | t)) | ||
| 30 : | (cond ((funcall isend?) (exit))))) | ||
| 31 : | |||
| 32 : | ;; ---------- ;; | ||
| 33 : | ;; local loop ;; | ||
| 34 : | ;; ---------- ;; | ||
| 35 : | (defun loop-disable-other-win (win isend?) | ||
| 36 : | (if (not (listp win)) | ||
| 37 : | (setq win (ncons win))) | ||
| 38 : | (let ((disp (window-display (car win)))) | ||
| 39 : | (loop | ||
| 40 : | (event-case (disp) | ||
| 41 : | (:exposure | ||
| 42 : | (event-window count) | ||
| 43 : | (and (0= count) (handle-exposure event-window)) | ||
| 44 : | t) | ||
| 45 : | (:button-press | ||
| 46 : | (event-window code x y) | ||
| 47 : | (and (memq event-window win) | ||
| 48 : | (handle-button-press event-window code x y)) | ||
| 49 : | t) | ||
| 50 : | (:button-release | ||
| 51 : | (event-window code x y) | ||
| 52 : | (and (memq event-window win) | ||
| 53 : | (handle-button-release event-window code x y)) | ||
| 54 : | t) | ||
| 55 : | (:motion-notify | ||
| 56 : | (event-window x y) | ||
| 57 : | (and (memq event-window win) | ||
| 58 : | (handle-motion-notify event-window x y)) | ||
| 59 : | t) | ||
| 60 : | (:enter-notify | ||
| 61 : | (event-window) | ||
| 62 : | (and (memq event-window win) | ||
| 63 : | (handle-enter-notify event-window)) | ||
| 64 : | t) | ||
| 65 : | (:leave-notify | ||
| 66 : | (event-window) | ||
| 67 : | (and (memq event-window win) | ||
| 68 : | (handle-leave-notify event-window)) | ||
| 69 : | t) | ||
| 70 : | (otherwise | ||
| 71 : | t)) | ||
| 72 : | (cond ((funcall isend?) (exit)))))) | ||
| 73 : |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |