[wadalabfont-kit] / lisp / tools / loop.l  

Annotation of /lisp/tools/loop.l

Parent Directory | Revision Log

Revision: 1.1.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