View of /lisp/tools/loop.l

Parent Directory

Revision Log

change to CVS wadalab font project

;; --------- ;;
;; 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))))))