This example involves more work, but you get a little more for your effort. It defines two objects, input-box and slider, and establishes a :key-press handler for each object, key-pressed and slider-pressed. We have two object sets because we handle events on the windows manifesting these objects differently, but the events come over the same display connection.
(in-package "SERVER-EXAMPLE")(defstruct (input-box (:print-function print-input-box) (:constructor make-input-box (display window))) "Our program knows about input-boxes, and it doesn't care how they are implemented." display ; The CLX display on which my input-box is displayed. window) ; The CLX window in which the user types. ;;; (defun print-input-box (object stream n) (declare (ignore n)) (format stream "#<Input-Box S>" (input-box-display object)))
(defvar *input-box-windows* (system:make-object-set "Input Box Windows" #'ext:default-clx-event-handler))
(defun key-pressed (input-box event-key event-window root child same-screen-p x y root-x root-y modifiers time key-code send-event-p) "This is our :key-press event handler." (declare (ignore event-key root child same-screen-p x y root-x root-y time send-event-p)) (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 (input-box-display input-box) key-code modifiers))) ;;; (ext:serve-key-press *input-box-windows* #'key-pressed)
(defstruct (slider (:print-function print-slider)
(:include input-box)
(:constructor (display window window-width max)))
"Our program knows about sliders too, and these provide input values
zero to max."
bits-per-value ; bits per discrete value up to max.
max) ; End value for slider.
;;;
(defun print-slider (object stream n)
(declare (ignore n))
(format stream "#<Slider S 0.. D>"
(input-box-display object)
(1- (slider-max object))))
;;;
(defun make-slider (display window max)
((truncate (xlib:drawable-width window) max)
max))
(defvar *slider-windows*
(system:make-object-set "Slider Windows"
#'ext:default-clx-event-handler))
(defun slider-pressed (slider event-key event-window root child
same-screen-p x y root-x root-y modifiers time
key-code send-event-p)
"This is our :key-press event handler for sliders. Probably this is
a mouse thing, but for simplicity here we take a character typed."
(declare (ignore event-key root child same-screen-p x y
root-x root-y time send-event-p))
(format t "KEY-PRESSED (Window = D) = S -> D. (xlib:window-id event-window)
;; See Hemlock Command Implementor's Manual for convenient
;; input mapping function.
(ext:translate-character (input-box-display slider)
key-code modifiers)
(truncate x (slider-bits-per-value slider))))
;;;
(ext:serve-key-press *slider-windows* #'slider-pressed)
(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))
(iwindow (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)))
(swindow (create-window :parent (screen-root screen)
:x 0 :y 300 :width 200 :height 50
:background white :border black
:border-width 2
:event-mask
(xlib:make-event-mask :key-press)))
(input-box (make-input-box display iwindow))
(slider (make-slider display swindow 15)))
;; 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
#'ext:object-set-event-handler)
;; Add the windows to the appropriate object sets.
(system:add-xwindow-object iwindow input-box
*input-box-windows*)
(system:add-xwindow-object swindow slider
*slider-windows*)
;; Map the windows to the screen.
(map-window iwindow)
(map-window swindow)
;; Make sure we send all our requests.
(display-force-output display)
;; Call server 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)
(delete-window iwindow display)
(delete-window swindow display)
;; Close the display.
(xlib:close-display display))))
(defun delete-window (window display)
;; Remove the windows from the object sets before destroying them.
(system:remove-xwindow-object window)
;; Destroy 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))))
(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))