1 files changed, 607 insertions, 0 deletions

@@ -0,0 +1,607 @@
+;;; (acdw xlib) --- xlib wrapper ... wrapper
+;; Rationale: the xlib egg is by its own admission pretty raw.  this library
+;; tries to cook it a little.
+
+(import xlib
+        (chicken bitwise)
+        (acdwm util))
+(import-for-syntax (acdwm util))
+
+(define *xdisplay
+  (make-parameter
+   (delay (xopendisplay #f))))
+
+(define-public (get-display)
+  (force (*xdisplay)))
+
+(define-public (get-screen #!optional (dpy (get-display)))
+  (xdefaultscreen dpy))
+
+(define-public (get-root #!optional (dpy (get-display)) scrn)
+  (dprint "getting root")
+  (xrootwindow dpy (or scrn (get-screen dpy))))
+
+;;; Constants
+
+(define-public TRUE 1)
+(define-public FALSE 0)
+
+;;; Working with X structures
+;; These functions wrap C functions with 'return pointers'
+
+(define-public (get-next-event #!optional (dpy (get-display)))
+  (let ((event (make-xevent)))
+    (xnextevent dpy event)
+    (dprint "get-next-event: " (xevent-type-name (xevent-type event)))
+    event))
+
+(define-public (get-next-masked-event mask #!optional (dpy (get-display)))
+  (let ((event (make-xevent)))
+    (xmaskevent dpy mask event)
+    event))
+
+(define-public (get-window-attributes win #!optional (dpy (get-display)))
+  (let ((attrs (make-xwindowattributes)))
+    (xgetwindowattributes dpy win attrs)
+    attrs))
+
+;; And these wrap C functions to make sure resources are freed
+
+(define-public (call-with-modifier-keymap proc #!optional (dpy (get-display)))
+  (let ((modmap (make-xmodifierkeymap)))
+    (dynamic-wind (lambda () (set! modmap (xgetmodifiermapping dpy)))
+                  (lambda () (proc modmap))
+                  (lambda () (free-xmodifierkeymap modmap)))))
+
+;;; Predicates
+
+(define-public (none? x)                ; this could be zero? ... but maybe
+  (= NONE x))                           ; it'll change!
+
+(define-public some?                    ; neologism
+  (complement none?))
+
+;; Events
+(define-syntax define-event-predicate
+  (syntax-rules ()
+    ((define-event-predicate predicate event)
+     (define-public (predicate ev*)
+       (= event (xevent-type ev*))))))
+
+(define-event-predicate buttonpress? BUTTONPRESS)
+(define-event-predicate buttonrelease? BUTTONRELEASE)
+(define-event-predicate circulatenotify? CIRCULATENOTIFY)
+(define-event-predicate clientmessage? CLIENTMESSAGE)
+(define-event-predicate colormapnotify? COLORMAPNOTIFY)
+(define-event-predicate createnotify? CREATENOTIFY)
+(define-event-predicate destroynotify? DESTROYNOTIFY)
+(define-event-predicate enternotify? ENTERNOTIFY)
+(define-event-predicate expose? EXPOSE)
+(define-event-predicate focuschangemask? FOCUSCHANGEMASK)
+(define-event-predicate graphicsexpose? GRAPHICSEXPOSE)
+(define-event-predicate gravitynotify? GRAVITYNOTIFY)
+(define-event-predicate keypress? KEYPRESS)
+(define-event-predicate keyrelease? KEYRELEASE)
+(define-event-predicate keymapnotify? KEYMAPNOTIFY)
+(define-event-predicate leavenotify? LEAVENOTIFY)
+(define-event-predicate mapnotify? MAPNOTIFY)
+(define-event-predicate maprequest? MAPREQUEST)
+(define-event-predicate mappingnotify? MAPPINGNOTIFY)
+(define-event-predicate motionnotify? MOTIONNOTIFY)
+(define-event-predicate propertynotify? PROPERTYNOTIFY)
+(define-event-predicate reparentnotify? REPARENTNOTIFY)
+(define-event-predicate resizerequest? RESIZEREQUEST)
+(define-event-predicate selectionclear? SELECTIONCLEAR)
+(define-event-predicate selectionnotify? SELECTIONNOTIFY)
+(define-event-predicate selectionrequest? SELECTIONREQUEST)
+(define-event-predicate substructureredirectmask? SUBSTRUCTUREREDIRECTMASK)
+(define-event-predicate unmapnotify? UNMAPNOTIFY)
+(define-event-predicate visibilitynotify? VISIBILITYNOTIFY)
+;; (define-event-predicate xconfigureevent? XCONFIGUREEVENT)
+;; (define-event-predicate xconfigurerequestevent? XCONFIGUREREQUESTEVENT)
+;; (define-event-predicate xdestroywindowevent? XDESTROYWINDOWEVENT)
+;; (define-event-predicate xfocusoutevent? XFOCUSOUTEVENT)
+;; (define-event-predicate xgravityevent? XGRAVITYEVENT)
+;; (define-event-predicate xmapevent? XMAPEVENT)
+;; (define-event-predicate xnoexposeevent? XNOEXPOSEEVENT)
+;; (define-event-predicate xreparentevent? XREPARENTEVENT)
+;; (define-event-predicate xunmapevent? XUNMAPEVENT)
+
+;;; Deconstructing the XEvent union type
+
+(define-syntax define-xevent->subevent
+  (er-macro-transformer
+   (lambda (x r c)
+     (define (string-append->symbol . ss)
+       (string->symbol (apply string-append ss)))
+     ;; (define-xevent->subevent name . props)
+     (let* ((name (symbol->string (cadr x)))
+            (evname (string-append name "event"))
+            (fnname (string-append->symbol "xevent->" name "event")))
+       `(,(r 'define-public) (,fnname ,(r 'xev))
+         (dprint ',fnname)
+         (,(r 'let) ((,(r 'out) (,(string-append->symbol "make-" evname))))
+          ,@(map (lambda (p)
+                   ;; set-<evname>-<prop>! out (xevent-<name>-prop xev)
+                   (let* ((pname (symbol->string p))
+                          (form
+                           `(,(string-append->symbol "set-" evname "-" pname "!")
+                             ,(r 'out)
+                             (,(string-append->symbol "xevent-" name "-" pname)
+                              ,(r 'xev)))))
+                     `(begin (dprint ',form)
+                             ,form)))
+                 (cddr x))
+          (,(r 'free-xevent) ,(r 'xev))
+          ,(r 'out)))))))
+
+
+(define-xevent->subevent xany
+  type display send_event serial type window)
+(define-xevent->subevent xkey
+  type serial send_event display window root subwindow time
+  x y x_root y_root state keycode same_screen)
+(define-xevent->subevent xbutton
+  type serial send_event display window root subwindow time
+  x y x_root y_root state button same_screen)
+(define-xevent->subevent xmotion
+  type serial send_event display window root subwindow time
+  x y x_root y_root state is_hint same_screen)
+(define-xevent->subevent xcrossing
+  type serial send_event display window root subwindow time
+  x y x_root y_root mode detail same_screen focus state)
+(define-xevent->subevent xexpose
+  type serial send_event display window x y width height count)
+(define-xevent->subevent xgraphicsexpose
+  type serial send_event display drawable x y width height
+  count major_code minor_code)
+(define-xevent->subevent xnoexpose
+  type serial send_event display drawable major_code minor_code)
+(define-xevent->subevent xvisibility
+  type serial send_event display window state)
+(define-xevent->subevent xcreatewindow
+  type serial send_event display parent window
+  x y width height border_width override_redirect)
+(define-xevent->subevent xdestroywindow
+  type serial send_event display event window)
+(define-xevent->subevent xunmap
+  type serial send_event display event window from_configure)
+(define-xevent->subevent xmap
+  type serial send_event display event window override_redirect)
+(define-xevent->subevent xmaprequest
+  type serial send_event display parent window)
+(define-xevent->subevent xreparent
+  type serial send_event display event window parent override_redirect)
+(define-xevent->subevent xconfigure
+  type serial send_event display event window
+  x y width height border_width above override_redirect)
+(define-xevent->subevent xgravity
+  type serial send_event display event window x y)
+(define-xevent->subevent xresizerequest
+  type serial send_event display window width height)
+(define-xevent->subevent xconfigurerequest
+  type serial send_event display parent window
+  x y width height border_width above detail value_mask)
+(define-xevent->subevent xcirculate
+  type serial send_event display event window place)
+(define-xevent->subevent xcirculaterequest
+  type serial send_event display parent window place)
+(define-xevent->subevent xproperty
+  type serial send_event display window atom time state)
+(define-xevent->subevent xselectionclear
+  type serial send_event display window selection time)
+(define-xevent->subevent xselectionrequest
+  type serial send_event display owner requestor selection
+  target property time)
+(define-xevent->subevent xselection
+  type serial send_event display requestor selection
+  target property time)
+(define-xevent->subevent xcolormap
+  type serial send_event display window colormap new state)
+(define-xevent->subevent xmapping
+  type serial send_event display window request first_keycode count)
+(define-xevent->subevent xerror
+  type display resourceid serial
+  error_code request_code minor_code)
+;; (define-xevent->subevent xfocuschange)
+#;(define-xevent->subevent xclient
+type serial send_event display window message_type format
+data-b data-s data-l)
+#;(define-xevent->subevent xkeymap
+type serial send_event display window key_vector)
+
+;;; Keysyms, keycodes, etc.
+
+(define (keysym->keycode ks #!optional (dpy (get-display)))
+  (char->integer (xkeysymtokeycode dpy ks)))
+
+(define-public (symbol->keysym xk_symbol)
+  ;;; XK_<NAME> => <the integer defined by XK_<NAME>>
+  (let ((ks (alist-ref xk_symbol keysyms)))
+    (and ks ks)))
+
+(define-public (->keycode keysym/xk_symbol #!optional (dpy (get-display)))
+  ;; Because it's all integers at the bottom, this function assumes that its
+  ;; argument denotes a Keysym.
+  (cond
+   ((number? keysym/xk_symbol)
+    (keysym->keycode keysym/xk_symbol))
+   ((symbol? keysym/xk_symbol)
+    (keysym->keycode (symbol->keysym keysym/xk_symbol)))
+   ((char? keysym/xk_symbol)            ; a weird situation but w/e
+    (char->integer keysym/xk_symbol))
+   (else #f)))
+
+(define keysyms
+  `((XK_BACKSPACE . ,XK_BACKSPACE)
+    (XK_0 . ,XK_0)
+    (XK_1 . ,XK_1)
+    (XK_2 . ,XK_2)
+    (XK_3 . ,XK_3)
+    (XK_4 . ,XK_4)
+    (XK_5 . ,XK_5)
+    (XK_6 . ,XK_6)
+    (XK_7 . ,XK_7)
+    (XK_8 . ,XK_8)
+    (XK_9 . ,XK_9)
+    (XK_A . ,XK_A)
+    (XK_AACUTE . ,XK_AACUTE)
+    (XK_ACIRCUMFLEX . ,XK_ACIRCUMFLEX)
+    (XK_ACUTE . ,XK_ACUTE)
+    (XK_ADIAERESIS . ,XK_ADIAERESIS)
+    (XK_AE . ,XK_AE)
+    (XK_AGRAVE . ,XK_AGRAVE)
+    (XK_ALT_L . ,XK_ALT_L)
+    (XK_ALT_R . ,XK_ALT_R)
+    (XK_AMPERSAND . ,XK_AMPERSAND)
+    (XK_ARING . ,XK_ARING)
+    (XK_ASCIICIRCUM . ,XK_ASCIICIRCUM)
+    (XK_ASCIITILDE . ,XK_ASCIITILDE)
+    (XK_ASTERISK . ,XK_ASTERISK)
+    (XK_AT . ,XK_AT)
+    (XK_ATILDE . ,XK_ATILDE)
+    (XK_B . ,XK_B)
+    (XK_BACKSLASH . ,XK_BACKSLASH)
+    (XK_BAR . ,XK_BAR)
+    (XK_BEGIN . ,XK_BEGIN)
+    (XK_BRACELEFT . ,XK_BRACELEFT)
+    (XK_BRACERIGHT . ,XK_BRACERIGHT)
+    (XK_BRACKETLEFT . ,XK_BRACKETLEFT)
+    (XK_BRACKETRIGHT . ,XK_BRACKETRIGHT)
+    (XK_BREAK . ,XK_BREAK)
+    (XK_BROKENBAR . ,XK_BROKENBAR)
+    (XK_C . ,XK_C)
+    (XK_CANCEL . ,XK_CANCEL)
+    (XK_CAPS_LOCK . ,XK_CAPS_LOCK)
+    (XK_CCEDILLA . ,XK_CCEDILLA)
+    (XK_CEDILLA . ,XK_CEDILLA)
+    (XK_CENT . ,XK_CENT)
+    (XK_CLEAR . ,XK_CLEAR)
+    (XK_COLON . ,XK_COLON)
+    (XK_COMMA . ,XK_COMMA)
+    (XK_CONTROL_L . ,XK_CONTROL_L)
+    (XK_CONTROL_R . ,XK_CONTROL_R)
+    (XK_COPYRIGHT . ,XK_COPYRIGHT)
+    (XK_CURRENCY . ,XK_CURRENCY)
+    (XK_D . ,XK_D)
+    (XK_DEGREE . ,XK_DEGREE)
+    (XK_DELETE . ,XK_DELETE)
+    (XK_DIAERESIS . ,XK_DIAERESIS)
+    (XK_DIVISION . ,XK_DIVISION)
+    (XK_DOLLAR . ,XK_DOLLAR)
+    (XK_DOWN . ,XK_DOWN)
+    (XK_E . ,XK_E)
+    (XK_EACUTE . ,XK_EACUTE)
+    (XK_ECIRCUMFLEX . ,XK_ECIRCUMFLEX)
+    (XK_EDIAERESIS . ,XK_EDIAERESIS)
+    (XK_EGRAVE . ,XK_EGRAVE)
+    (XK_END . ,XK_END)
+    (XK_EQUAL . ,XK_EQUAL)
+    (XK_ESCAPE . ,XK_ESCAPE)
+    (XK_ETH . ,XK_ETH)
+    (XK_EXCLAM . ,XK_EXCLAM)
+    (XK_EXCLAMDOWN . ,XK_EXCLAMDOWN)
+    (XK_EXECUTE . ,XK_EXECUTE)
+    (XK_F . ,XK_F)
+    (XK_F1 . ,XK_F1)
+    (XK_F10 . ,XK_F10)
+    (XK_F11 . ,XK_F11)
+    (XK_F12 . ,XK_F12)
+    (XK_F13 . ,XK_F13)
+    (XK_F14 . ,XK_F14)
+    (XK_F15 . ,XK_F15)
+    (XK_F16 . ,XK_F16)
+    (XK_F17 . ,XK_F17)
+    (XK_F18 . ,XK_F18)
+    (XK_F19 . ,XK_F19)
+    (XK_F2 . ,XK_F2)
+    (XK_F20 . ,XK_F20)
+    (XK_F21 . ,XK_F21)
+    (XK_F22 . ,XK_F22)
+    (XK_F23 . ,XK_F23)
+    (XK_F24 . ,XK_F24)
+    (XK_F25 . ,XK_F25)
+    (XK_F26 . ,XK_F26)
+    (XK_F27 . ,XK_F27)
+    (XK_F28 . ,XK_F28)
+    (XK_F29 . ,XK_F29)
+    (XK_F3 . ,XK_F3)
+    (XK_F30 . ,XK_F30)
+    (XK_F31 . ,XK_F31)
+    (XK_F32 . ,XK_F32)
+    (XK_F33 . ,XK_F33)
+    (XK_F34 . ,XK_F34)
+    (XK_F35 . ,XK_F35)
+    (XK_F4 . ,XK_F4)
+    (XK_F5 . ,XK_F5)
+    (XK_F6 . ,XK_F6)
+    (XK_F7 . ,XK_F7)
+    (XK_F8 . ,XK_F8)
+    (XK_F9 . ,XK_F9)
+    (XK_FIND . ,XK_FIND)
+    (XK_G . ,XK_G)
+    (XK_GREATER . ,XK_GREATER)
+    (XK_GUILLEMOTLEFT . ,XK_GUILLEMOTLEFT)
+    (XK_GUILLEMOTRIGHT . ,XK_GUILLEMOTRIGHT)
+    (XK_H . ,XK_H)
+    (XK_HELP . ,XK_HELP)
+    (XK_HOME . ,XK_HOME)
+    (XK_HYPER_L . ,XK_HYPER_L)
+    (XK_HYPER_R . ,XK_HYPER_R)
+    (XK_HYPHEN . ,XK_HYPHEN)
+    (XK_I . ,XK_I)
+    (XK_IACUTE . ,XK_IACUTE)
+    (XK_ICIRCUMFLEX . ,XK_ICIRCUMFLEX)
+    (XK_IDIAERESIS . ,XK_IDIAERESIS)
+    (XK_IGRAVE . ,XK_IGRAVE)
+    (XK_INSERT . ,XK_INSERT)
+    (XK_J . ,XK_J)
+    (XK_K . ,XK_K)
+    (XK_KANJI . ,XK_KANJI)
+    (XK_KP_0 . ,XK_KP_0)
+    (XK_KP_1 . ,XK_KP_1)
+    (XK_KP_2 . ,XK_KP_2)
+    (XK_KP_3 . ,XK_KP_3)
+    (XK_KP_4 . ,XK_KP_4)
+    (XK_KP_5 . ,XK_KP_5)
+    (XK_KP_6 . ,XK_KP_6)
+    (XK_KP_7 . ,XK_KP_7)
+    (XK_KP_8 . ,XK_KP_8)
+    (XK_KP_9 . ,XK_KP_9)
+    (XK_KP_ADD . ,XK_KP_ADD)
+    (XK_KP_DECIMAL . ,XK_KP_DECIMAL)
+    (XK_KP_DIVIDE . ,XK_KP_DIVIDE)
+    (XK_KP_ENTER . ,XK_KP_ENTER)
+    (XK_KP_EQUAL . ,XK_KP_EQUAL)
+    (XK_KP_F1 . ,XK_KP_F1)
+    (XK_KP_F2 . ,XK_KP_F2)
+    (XK_KP_F3 . ,XK_KP_F3)
+    (XK_KP_F4 . ,XK_KP_F4)
+    (XK_KP_MULTIPLY . ,XK_KP_MULTIPLY)
+    (XK_KP_SEPARATOR . ,XK_KP_SEPARATOR)
+    (XK_KP_SPACE . ,XK_KP_SPACE)
+    (XK_KP_SUBTRACT . ,XK_KP_SUBTRACT)
+    (XK_KP_TAB . ,XK_KP_TAB)
+    (XK_L . ,XK_L)
+    (XK_L1 . ,XK_L1)
+    (XK_L10 . ,XK_L10)
+    (XK_L2 . ,XK_L2)
+    (XK_L3 . ,XK_L3)
+    (XK_L4 . ,XK_L4)
+    (XK_L5 . ,XK_L5)
+    (XK_L6 . ,XK_L6)
+    (XK_L7 . ,XK_L7)
+    (XK_L8 . ,XK_L8)
+    (XK_L9 . ,XK_L9)
+    (XK_LCA . ,XK_LCA)
+    (XK_LCAACUTE . ,XK_LCAACUTE)
+    (XK_LCACIRCUMFLEX . ,XK_LCACIRCUMFLEX)
+    (XK_LCADIAERESIS . ,XK_LCADIAERESIS)
+    (XK_LCAE . ,XK_LCAE)
+    (XK_LCAGRAVE . ,XK_LCAGRAVE)
+    (XK_LCARING . ,XK_LCARING)
+    (XK_LCATILDE . ,XK_LCATILDE)
+    (XK_LCB . ,XK_LCB)
+    (XK_LCC . ,XK_LCC)
+    (XK_LCCCEDILLA . ,XK_LCCCEDILLA)
+    (XK_LCD . ,XK_LCD)
+    (XK_LCE . ,XK_LCE)
+    (XK_LCEACUTE . ,XK_LCEACUTE)
+    (XK_LCECIRCUMFLEX . ,XK_LCECIRCUMFLEX)
+    (XK_LCEDIAERESIS . ,XK_LCEDIAERESIS)
+    (XK_LCEGRAVE . ,XK_LCEGRAVE)
+    (XK_LCETH . ,XK_LCETH)
+    (XK_LCF . ,XK_LCF)
+    (XK_LCG . ,XK_LCG)
+    (XK_LCH . ,XK_LCH)
+    (XK_LCI . ,XK_LCI)
+    (XK_LCIACUTE . ,XK_LCIACUTE)
+    (XK_LCICIRCUMFLEX . ,XK_LCICIRCUMFLEX)
+    (XK_LCIDIAERESIS . ,XK_LCIDIAERESIS)
+    (XK_LCIGRAVE . ,XK_LCIGRAVE)
+    (XK_LCJ . ,XK_LCJ)
+    (XK_LCK . ,XK_LCK)
+    (XK_LCL . ,XK_LCL)
+    (XK_LCM . ,XK_LCM)
+    (XK_LCN . ,XK_LCN)
+    (XK_LCNTILDE . ,XK_LCNTILDE)
+    (XK_LCO . ,XK_LCO)
+    (XK_LCOACUTE . ,XK_LCOACUTE)
+    (XK_LCOCIRCUMFLEX . ,XK_LCOCIRCUMFLEX)
+    (XK_LCODIAERESIS . ,XK_LCODIAERESIS)
+    (XK_LCOGRAVE . ,XK_LCOGRAVE)
+    (XK_LCOTILDE . ,XK_LCOTILDE)
+    (XK_LCP . ,XK_LCP)
+    (XK_LCQ . ,XK_LCQ)
+    (XK_LCR . ,XK_LCR)
+    (XK_LCS . ,XK_LCS)
+    (XK_LCT . ,XK_LCT)
+    (XK_LCTHORN . ,XK_LCTHORN)
+    (XK_LCU . ,XK_LCU)
+    (XK_LCUACUTE . ,XK_LCUACUTE)
+    (XK_LCUCIRCUMFLEX . ,XK_LCUCIRCUMFLEX)
+    (XK_LCUDIAERESIS . ,XK_LCUDIAERESIS)
+    (XK_LCUGRAVE . ,XK_LCUGRAVE)
+    (XK_LCV . ,XK_LCV)
+    (XK_LCW . ,XK_LCW)
+    (XK_LCX . ,XK_LCX)
+    (XK_LCY . ,XK_LCY)
+    (XK_LCYACUTE . ,XK_LCYACUTE)
+    (XK_LCZ . ,XK_LCZ)
+    (XK_LEFT . ,XK_LEFT)
+    (XK_LESS . ,XK_LESS)
+    (XK_LINEFEED . ,XK_LINEFEED)
+    (XK_M . ,XK_M)
+    (XK_MACRON . ,XK_MACRON)
+    (XK_MASCULINE . ,XK_MASCULINE)
+    (XK_MENU . ,XK_MENU)
+    (XK_META_L . ,XK_META_L)
+    (XK_META_R . ,XK_META_R)
+    (XK_MINUS . ,XK_MINUS)
+    (XK_MODE_SWITCH . ,XK_MODE_SWITCH)
+    (XK_MU . ,XK_MU)
+    (XK_MULTIPLY . ,XK_MULTIPLY)
+    (XK_MULTI_KEY . ,XK_MULTI_KEY)
+    (XK_N . ,XK_N)
+    (XK_NEXT . ,XK_NEXT)
+    (XK_NOBREAKSPACE . ,XK_NOBREAKSPACE)
+    (XK_NOTSIGN . ,XK_NOTSIGN)
+    (XK_NTILDE . ,XK_NTILDE)
+    (XK_NUMBERSIGN . ,XK_NUMBERSIGN)
+    (XK_NUM_LOCK . ,XK_NUM_LOCK)
+    (XK_O . ,XK_O)
+    (XK_OACUTE . ,XK_OACUTE)
+    (XK_OCIRCUMFLEX . ,XK_OCIRCUMFLEX)
+    (XK_ODIAERESIS . ,XK_ODIAERESIS)
+    (XK_OGRAVE . ,XK_OGRAVE)
+    (XK_ONEHALF . ,XK_ONEHALF)
+    (XK_ONEQUARTER . ,XK_ONEQUARTER)
+    (XK_ONESUPERIOR . ,XK_ONESUPERIOR)
+    (XK_OOBLIQUE . ,XK_OOBLIQUE)
+    (XK_ORDFEMININE . ,XK_ORDFEMININE)
+    (XK_OSLASH . ,XK_OSLASH)
+    (XK_OTILDE . ,XK_OTILDE)
+    (XK_P . ,XK_P)
+    (XK_PARAGRAPH . ,XK_PARAGRAPH)
+    (XK_PARENLEFT . ,XK_PARENLEFT)
+    (XK_PARENRIGHT . ,XK_PARENRIGHT)
+    (XK_PAUSE . ,XK_PAUSE)
+    (XK_PERCENT . ,XK_PERCENT)
+    (XK_PERIOD . ,XK_PERIOD)
+    (XK_PERIODCENTERED . ,XK_PERIODCENTERED)
+    (XK_PLUS . ,XK_PLUS)
+    (XK_PLUSMINUS . ,XK_PLUSMINUS)
+    (XK_PRINT . ,XK_PRINT)
+    (XK_PRIOR . ,XK_PRIOR)
+    (XK_Q . ,XK_Q)
+    (XK_QUESTION . ,XK_QUESTION)
+    (XK_QUESTIONDOWN . ,XK_QUESTIONDOWN)
+    (XK_QUOTEDBL . ,XK_QUOTEDBL)
+    (XK_QUOTELEFT . ,XK_QUOTELEFT)
+    (XK_QUOTERIGHT . ,XK_QUOTERIGHT)
+    (XK_R . ,XK_R)
+    (XK_R1 . ,XK_R1)
+    (XK_R10 . ,XK_R10)
+    (XK_R11 . ,XK_R11)
+    (XK_R12 . ,XK_R12)
+    (XK_R13 . ,XK_R13)
+    (XK_R14 . ,XK_R14)
+    (XK_R15 . ,XK_R15)
+    (XK_R2 . ,XK_R2)
+    (XK_R3 . ,XK_R3)
+    (XK_R4 . ,XK_R4)
+    (XK_R5 . ,XK_R5)
+    (XK_R6 . ,XK_R6)
+    (XK_R7 . ,XK_R7)
+    (XK_R8 . ,XK_R8)
+    (XK_R9 . ,XK_R9)
+    (XK_REDO . ,XK_REDO)
+    (XK_REGISTERED . ,XK_REGISTERED)
+    (XK_RETURN . ,XK_RETURN)
+    (XK_RIGHT . ,XK_RIGHT)
+    (XK_S . ,XK_S)
+    (XK_SCRIPT_SWITCH . ,XK_SCRIPT_SWITCH)
+    (XK_SECTION . ,XK_SECTION)
+    (XK_SELECT . ,XK_SELECT)
+    (XK_SEMICOLON . ,XK_SEMICOLON)
+    (XK_SHIFT_L . ,XK_SHIFT_L)
+    (XK_SHIFT_LOCK . ,XK_SHIFT_LOCK)
+    (XK_SHIFT_R . ,XK_SHIFT_R)
+    (XK_SLASH . ,XK_SLASH)
+    (XK_SPACE . ,XK_SPACE)
+    (XK_SSHARP . ,XK_SSHARP)
+    (XK_STERLING . ,XK_STERLING)
+    (XK_SUPER_L . ,XK_SUPER_L)
+    (XK_SUPER_R . ,XK_SUPER_R)
+    (XK_T . ,XK_T)
+    (XK_TAB . ,XK_TAB)
+    (XK_THORN . ,XK_THORN)
+    (XK_THREEQUARTERS . ,XK_THREEQUARTERS)
+    (XK_THREESUPERIOR . ,XK_THREESUPERIOR)
+    (XK_TWOSUPERIOR . ,XK_TWOSUPERIOR)
+    (XK_U . ,XK_U)
+    (XK_UACUTE . ,XK_UACUTE)
+    (XK_UCIRCUMFLEX . ,XK_UCIRCUMFLEX)
+    (XK_UDIAERESIS . ,XK_UDIAERESIS)
+    (XK_UGRAVE . ,XK_UGRAVE)
+    (XK_UNDERSCORE . ,XK_UNDERSCORE)
+    (XK_UNDO . ,XK_UNDO)
+    (XK_UP . ,XK_UP)
+    (XK_V . ,XK_V)
+    (XK_W . ,XK_W)
+    (XK_X . ,XK_X)
+    (XK_Y . ,XK_Y)
+    (XK_YACUTE . ,XK_YACUTE)
+    (XK_YDIAERESIS . ,XK_YDIAERESIS)
+    (XK_YEN . ,XK_YEN)
+    (XK_Z . ,XK_Z)
+    (DXK_ACUTE_ACCENT . ,DXK_ACUTE_ACCENT)
+    (DXK_CEDILLA_ACCENT . ,DXK_CEDILLA_ACCENT)
+    (DXK_CIRCUMFLEX_ACCENT . ,DXK_CIRCUMFLEX_ACCENT)
+    (DXK_DIAERESIS . ,DXK_DIAERESIS)
+    (DXK_GRAVE_ACCENT . ,DXK_GRAVE_ACCENT)
+    (DXK_REMOVE . ,DXK_REMOVE)
+    (DXK_RING_ACCENT . ,DXK_RING_ACCENT)
+    (DXK_TILDE . ,DXK_TILDE)))
+
+;;; Debugging
+
+(define xevent-types
+  `((,KEYPRESS . KEYPRESS)
+    (,KEYRELEASE . KEYRELEASE)
+    (,BUTTONPRESS . BUTTONPRESS)
+    (,BUTTONRELEASE . BUTTONRELEASE)
+    (,MOTIONNOTIFY . MOTIONNOTIFY)
+    (,ENTERNOTIFY . ENTERNOTIFY)
+    (,LEAVENOTIFY . LEAVENOTIFY)
+    (,FOCUSIN . FOCUSIN)
+    (,FOCUSOUT . FOCUSOUT)
+    (,KEYMAPNOTIFY . KEYMAPNOTIFY)
+    (,EXPOSE . EXPOSE)
+    (,GRAPHICSEXPOSE . GRAPHICSEXPOSE)
+    (,NOEXPOSE . NOEXPOSE)
+    (,VISIBILITYNOTIFY . VISIBILITYNOTIFY)
+    (,CREATENOTIFY . CREATENOTIFY)
+    (,DESTROYNOTIFY . DESTROYNOTIFY)
+    (,UNMAPNOTIFY . UNMAPNOTIFY)
+    (,MAPNOTIFY . MAPNOTIFY)
+    (,MAPREQUEST . MAPREQUEST)
+    (,REPARENTNOTIFY . REPARENTNOTIFY)
+    (,CONFIGURENOTIFY . CONFIGURENOTIFY)
+    (,CONFIGUREREQUEST . CONFIGUREREQUEST)
+    (,GRAVITYNOTIFY . GRAVITYNOTIFY)
+    (,RESIZEREQUEST . RESIZEREQUEST)
+    (,CIRCULATENOTIFY . CIRCULATENOTIFY)
+    (,CIRCULATEREQUEST . CIRCULATEREQUEST)
+    (,PROPERTYNOTIFY . PROPERTYNOTIFY)
+    (,SELECTIONCLEAR . SELECTIONCLEAR)
+    (,SELECTIONREQUEST . SELECTIONREQUEST)
+    (,SELECTIONNOTIFY . SELECTIONNOTIFY)
+    (,COLORMAPNOTIFY . COLORMAPNOTIFY)
+    (,CLIENTMESSAGE . CLIENTMESSAGE)
+    (,MAPPINGNOTIFY . MAPPINGNOTIFY)
+    #;(,GENERICEVENT . GENERICEVENT)))
+
+(define-public (xevent-type-name type)
+  (let ((x (assq type xevent-types)))
+    (and x (cdr x))))