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