(in-package "SERVER-EXAMPLE")

(defun my-input-handler (display)
  (xlib:event-case (display :timeout 0)
    (:key-press (event-window code state)
     (format t "KEY-PRESSED (Window = ~D) = ~S.~%"
                  (xlib:window-id event-window)
             ;; See Hemlock Command Implementor's Manual for convenient
             ;; input mapping function.
             (ext:translate-character display code state))
      ;; Make XLIB:EVENT-CASE discard the event.
      t)))

(defun server-example ()
  "An example of using the SYSTEM:SERVE-EVENT function and object sets to
   handle CLX events."
  (let* ((display (ext:open-clx-display))
         (screen (display-default-screen display))
         (black (screen-black-pixel screen))
         (white (screen-white-pixel screen))
         (window (create-window :parent (screen-root screen)
                                :x 0 :y 0 :width 200 :height 200
                                :background white :border black
                                :border-width 2
                                :event-mask
                                (xlib:make-event-mask :key-press))))
    ;; Wrap code in UNWIND-PROTECT, so we clean up after ourselves.
    (unwind-protect
        (progn
          ;; Enable event handling on the display.
          (ext:enable-clx-event-handling display #'my-input-handler)
          ;; Map the windows to the screen.
          (map-window window)
          ;; Make sure we send all our requests.
          (display-force-output display)
          ;; Call serve-event for 100,000 events or immediate timeouts.
          (dotimes (i 100000) (system:serve-event)))
      ;; Disable event handling on this display.
      (ext:disable-clx-event-handling display)
      ;; Get rid of the window.
      (destroy-window window)
      ;; Pick off any events the X server has already queued for our
      ;; windows, so we don't choke since SYSTEM:SERVE-EVENT is no longer
      ;; prepared to handle events for us.
      (loop
       (unless (deleting-window-drop-event *display* window)
        (return)))
      ;; Close the display.
      (xlib:close-display display))))

(defun deleting-window-drop-event (display win)
  "Check for any events on win.  If there is one, remove it from the
   event queue and return t; otherwise, return nil."
  (xlib:display-finish-output display)
  (let ((result nil))
    (xlib:process-event
     display :timeout 0
     :handler #'(lambda (&key event-window &allow-other-keys)
                  (if (eq event-window win)
                      (setf result t)
                      nil)))
    result))