From 8179c0025a44a769ab6ad2e5c0a58f545517280c Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 17 Jan 2024 00:24:11 -0600 Subject: Change organization and massively refactor --- lib/events.sld | 3 + lib/events.sls | 83 ++++++++ lib/keys.sld | 3 + lib/keys.sls | 252 ++++++++++++++++++++++++ lib/util.sld | 33 ++++ lib/xlib.sld | 4 + lib/xlib.sls | 607 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 985 insertions(+) create mode 100644 lib/events.sld create mode 100644 lib/events.sls create mode 100644 lib/keys.sld create mode 100644 lib/keys.sls create mode 100644 lib/util.sld create mode 100644 lib/xlib.sld create mode 100644 lib/xlib.sls (limited to 'lib') diff --git a/lib/events.sld b/lib/events.sld new file mode 100644 index 0000000..747d3ac --- /dev/null +++ b/lib/events.sld @@ -0,0 +1,3 @@ +(module (acdwm events) () + (import scheme (chicken base) (chicken module)) + (include-relative "events.sls")) diff --git a/lib/events.sls b/lib/events.sls new file mode 100644 index 0000000..9bb78ee --- /dev/null +++ b/lib/events.sls @@ -0,0 +1,83 @@ +;;; (acdwm events) --- event handlers + +(import (acdwm keys) + (acdwm xlib) + (acdwm util) + (srfi 1)) + +(export make-drag drag? drag-type drag-event drag-window drag-attrs) +(define-record drag type event window attrs) + +(define drag (make-parameter #f)) +(define drag-types '(move resize)) + +(define-public (initialize-drag type event) + (assert (memq type drag-types)) + (let ((win (and (buttonpress? event) + (xevent-xbutton-subwindow event)))) + (and win + (drag (make-drag type event win (get-window-attributes win)))))) + +(define-public (cancel-drag) + (free-xevent (drag-event (drag))) + (free-xwindowattributes (drag-attrs (drag))) + (drag #f)) + +(define-public (handle-events #!optional (dpy (get-display))) + (let loop ((this (get-next-event dpy))) + (dprint "handling a " (xevent-type-name (xevent-type this))) + (cond + ((keypress? this) + (handle-keypress this dpy) + (loop (get-next-event dpy))) + ((buttonpress? this) + (handle-buttonpress this) + (loop (get-next-event dpy))) + ((buttonrelease? this) + (handle-buttonrelease this) + (loop (get-next-event dpy))) + ((motionnotify? this) + (handle-motion this) + (loop (get-next-event dpy))) + ;; Make sure this is at the end! + (else + (loop (get-next-event dpy)))))) + +;;; Handlers + +(define-public (handle-keypress event + #!optional (dpy (get-display))) + (let ((binding (find-keybinding event))) + (dprint "handle-keypress: " binding) + (and binding ((keybind-proc binding) event dpy)))) + +(define-public (handle-buttonpress event + #!optional (dpy (get-display))) + (let ((binding (find-mousebinding event))) + (dprint "handle-buttonpress: " binding) + (and binding ((mousebind-proc binding) event dpy)))) + +(define-public (handle-buttonrelease event + #!optional (dpy (get-display))) + (dprint "handle-buttonrelease") + (cancel-drag)) + +(define-public (handle-motion event + #!optional (dpy (get-display))) + (dprint "handle-motion") + (when (drag) + (when (some? (drag-window (drag))) + (let ((xd (- (xevent-xbutton-x_root event) + (xevent-xbutton-x_root (drag-event (drag))))) + (yd (- (xevent-xbutton-y_root event) + (xevent-xbutton-y_root (drag-event (drag)))))) + (let ((xnew (+ (xwindowattributes-x (drag-attrs (drag))) + (if (eq? (drag-type (drag)) 'move) xd 0))) + (ynew (+ (xwindowattributes-y (drag-attrs (drag))) + (if (eq? (drag-type (drag)) 'move) yd 0))) + (wnew (max 1 (+ (xwindowattributes-width (drag-attrs (drag))) + (if (eq? (drag-type (drag)) 'resize) xd 0)))) + (hnew (max 1 (+ (xwindowattributes-height (drag-attrs (drag))) + (if (eq? (drag-type (drag)) 'resize) yd 0))))) + (dprint wnew "x" hnew "+" xnew "+" ynew) + (xmoveresizewindow dpy (drag-window (drag)) xnew ynew wnew hnew)))))) diff --git a/lib/keys.sld b/lib/keys.sld new file mode 100644 index 0000000..2a90845 --- /dev/null +++ b/lib/keys.sld @@ -0,0 +1,3 @@ +(module (acdwm keys) () + (import scheme (chicken base) (chicken module)) + (include-relative "keys.sls")) diff --git a/lib/keys.sls b/lib/keys.sls new file mode 100644 index 0000000..3be0384 --- /dev/null +++ b/lib/keys.sls @@ -0,0 +1,252 @@ +;;; (acdwm keys) --- key (and button!) binding tools + +(import (chicken bitwise) + (chicken irregex) + (chicken memory) + (srfi 1) + (acdwm xlib) + (acdwm util)) + +;;; Defining bindings + +(define-public bindings + (make-parameter '())) + +(export keybind keybind? + keybind-keycode keybind-modmask keybind-proc) +(define-record keybind + (setter keycode) + (setter modmask) + (setter proc)) + +(export mousebind mousebind? + mousebind-button mousebind-modmask mousebind-proc) +(define-record mousebind + (setter button) + (setter modmask) + (setter proc)) + +(define-public (bind kbd proc #!optional (dpy (get-display))) + ;;; Public interface for make-(keybind|mousebind). + (receive (key mods) (parse-bind-description kbd) + (print "binding " kbd " to " proc) + (let ((bind (if (<= 1 key 5) + (make-mousebind key mods proc) + (make-keybind (->keycode key dpy) mods proc)))) + (bindings (cons bind (bindings))) + (print "bindings: " (bindings))))) + +(define-public (unbind kbd) + (receive (key mods) (parse-bind-description kbd) + #f ; TODO + )) + +;;; Matching bindings + +(define-public (keybind-match? kb ev #!optional (dpy (get-display))) + (and (or (keypress? ev) (keyrelease? ev)) + (keybind? kb) + (and (= (xevent-xkey-keycode ev) (keybind-keycode kb)) + (= (clean-mask (xevent-xkey-state ev)) (keybind-modmask kb)) + (procedure? (keybind-proc kb))))) + +(define-public (find-keybinding ev) + (find (lambda (b) (keybind-match? b ev)) (bindings))) + +(define-public (mousebind-match? mb ev #!optional (dpy (get-display))) + (and (or (buttonpress? ev) (buttonrelease? ev)) + (mousebind? mb) + (and (= (xevent-xbutton-button ev) (mousebind-button mb)) + (= (clean-mask (xevent-xbutton-state ev)) (mousebind-modmask mb)) + (procedure? (mousebind-proc mb))))) + +(define-public (find-mousebinding ev) + (find (lambda (b) (mousebind-match? b ev)) (bindings))) + +;;; Numlock & Modkeys + +(define numlock + (make-parameter 0)) + +(define-public (update-numlock-mask #!optional (dpy (get-display))) + (call-with-modifier-keymap + (lambda (mm) + (let ((max-key-per-mod (xmodifierkeymap-max_keypermod mm))) + (do ((i 0 (add1 i))) + ((= i 8)) + (do ((k 0 (add1 k))) + ((= k max-key-per-mod)) + (let ((r (pointer-u8-ref ; a KeyBind is an unsigned char + (pointer+ (xmodifierkeymap-modifiermap mm) + (+ i (* max-key-per-mod k)))))) + (when (= r (->keycode XK_NUM_LOCK)) + (numlock (arithmetic-shift 1 i)))))))))) + +(define-public (clean-mask mask) + (bitwise-and mask + (bitwise-not (bitwise-ior (numlock) LOCKMASK)) + (bitwise-ior SHIFTMASK CONTROLMASK + MOD1MASK MOD2MASK MOD3MASK MOD4MASK MOD5MASK))) + +;;; Grabbing input + +(define *mods + (begin (update-numlock-mask) + (list 0 LOCKMASK (numlock) (bitwise-ior (numlock) LOCKMASK)))) + +(define (grab-key key #!optional (dpy (get-display))) + (when (keybind? key) +;; XXX (dprint "grabbing " ) + (for-each (lambda (mod) + (xgrabkey dpy + (keybind-keycode key) + (bitwise-ior mod (keybind-modmask key)) + (get-root dpy) + TRUE + GRABMODEASYNC + GRABMODEASYNC)) + *mods))) + +(define (grab-button btn #!optional (dpy (get-display))) + (when (mousebind? btn) + (for-each (lambda (mod) + (xgrabbutton dpy + (mousebind-button btn) + (bitwise-ior mod (mousebind-modmask btn)) + (get-root dpy) + TRUE + (bitwise-ior BUTTONPRESSMASK + BUTTONRELEASEMASK + POINTERMOTIONMASK) + GRABMODEASYNC + GRABMODEASYNC + NONE + NONE)) + *mods))) + +(define-public (grab-input #!optional + (bindings (bindings)) + (dpy (get-display))) + (xungrabkey dpy ANYKEY ANYMODIFIER (get-root dpy)) + (for-each grab-key (filter keybind? bindings)) + (for-each grab-button (filter mousebind? bindings))) + +;;; Parsing keybind descriptions +;; `bind' does Emacs-style binding descriptions in DESC. That is, it accepts a +;; string of the form MODS-KEY, where +;; - MODS is one of C, S, M, 1, 2, 3, 4, 5 (M = 1) (case-insensitive) +;; - KEY is one of +;; - - mouse buttons b1, b2, b3, b4, b5 (case-insensitive) +;; - - is passed through as a symbol +;; - - otherwise it's figured out through the `keycaps' alist + +;; NOTE: parse-bind-description returns a KeySym +(define-public (parse-bind-description desc) + (let* ((m (match-bind-desc desc)) + (p (cond + ((not m) #f) + ((irregex-match-substring m 'btn) => parse-button-match) + ((irregex-match-substring m 'raw) => parse-raw-match) + ((irregex-match-substring m 'key) => parse-key-match) + (else #f)))) + (if p + (values p (extract-modmask m)) + (values #f #f)))) + +(define (match-bind-desc desc) + (irregex-match '(: (? (=> mods (+ (or "C-" "S-" "M-" + "1-" "2-" "3-" "4-" "5-")))) + (or + (: (or #\B #\b) (=> btn ("12345"))) + (: #\< (=> raw (+ (or alnum #\_))) #\>) + (=> key any))) + desc)) + +(define (extract-modmask match) + (let ((m (irregex-match-substring match 'mods))) + (irregex-fold "[CSM12345]-" + (lambda (i n s) + (bitwise-ior s (case (string-ref + (irregex-match-substring n) 0) + ((#\C #\c) CONTROLMASK) + ((#\S #\s) SHIFTMASK) + ((#\M #\m #\1) MOD1MASK) + ((#\2) MOD2MASK) + ((#\3) MOD3MASK) + ((#\4) MOD4MASK) + ((#\5) MOD5MASK)))) + 0 + (or m "")))) + +(define (parse-button-match btn) + (string->number btn)) + +(define (parse-raw-match raw) + (string->keysym (string-append (if (irregex-match? "^D?XK_.*" raw) "" + "XK_") + (string-upcase raw)))) + +(define (char<= . cs) + (apply <= (map char->integer cs))) + +(define (parse-key-match key) + (let ((ch (string-ref key 0))) + (cond + ((char<= #\a ch #\z) + (string->keysym (string-append "XK_LC" (string (char-upcase ch))))) + ((char<= #\A ch #\Z) + (string->keysym (string-append "XK_" (string ch)))) + ((alist-ref ch keycaps)) + (else + (let ((ks (char->integer (xstringtokeysym key)))) + (if (zero? ks) #f ks)))))) + +(define (string->keysym str) + (symbol->keysym (string->symbol str))) + +(define (string-upcase str) + (list->string (map char-upcase (string->list str)))) + +(define keycaps + `((#\` . #x60) ; y no XK_GRAVE + (#\1 . ,XK_1) + (#\2 . ,XK_2) + (#\3 . ,XK_3) + (#\4 . ,XK_4) + (#\5 . ,XK_5) + (#\6 . ,XK_6) + (#\7 . ,XK_7) + (#\8 . ,XK_8) + (#\9 . ,XK_9) + (#\0 . ,XK_0) + (#\- . ,XK_MINUS) + (#\= . ,XK_EQUAL) + (#\[ . ,XK_BRACKETLEFT) + (#\] . ,XK_BRACKETRIGHT) + (#\\ . ,XK_BACKSLASH) + (#\; . ,XK_SEMICOLON) + (#\' . #x27) ; y no XK_APOSTROPHE + (#\, . ,XK_COMMA) + (#\. . ,XK_PERIOD) + (#\/ . ,XK_SLASH) + (#\~ . ,XK_ASCIITILDE) + (#\! . ,XK_EXCLAM) + (#\@ . ,XK_AT) + (#\# . ,XK_NUMBERSIGN) + (#\$ . ,XK_DOLLAR) + (#\% . ,XK_PERCENT) + (#\^ . ,XK_ASCIICIRCUM) + (#\& . ,XK_AMPERSAND) + (#\* . ,XK_ASTERISK) + (#\( . ,XK_PARENLEFT) + (#\) . ,XK_PARENRIGHT) + (#\_ . ,XK_UNDERSCORE) + (#\+ . ,XK_PLUS) + (#\{ . ,XK_BRACELEFT) + (#\} . ,XK_BRACERIGHT) + (#\| . ,XK_BAR) + (#\: . ,XK_COLON) + (#\" . ,XK_QUOTEDBL) + (#\< . ,XK_LESS) + (#\> . ,XK_GREATER) + (#\? . ,XK_QUESTION))) diff --git a/lib/util.sld b/lib/util.sld new file mode 100644 index 0000000..fc6a24b --- /dev/null +++ b/lib/util.sld @@ -0,0 +1,33 @@ +(module (acdwm util) ( + define-public + ignore + DEBUG + dprint + ) + + (import scheme (chicken base) + (chicken port)) + + (define-syntax define-public + (syntax-rules () + ((define-public (name . arg) forms ...) + (begin (export name) + (define (name . arg) forms ...))) + ((define-public (name args ...) forms ...) + (begin (export name) + (define (name args ...) forms ...))) + ((define-public name value) + (begin (export name) + (define name value))))) + + (define (ignore . _) #f) + + (define (eprint . xs) + (with-output-to-port (current-error-port) + (lambda () (apply print xs)))) + + (define DEBUG (make-parameter #f)) + + (define (dprint . xs) + (when (DEBUG) + (apply eprint xs)))) diff --git a/lib/xlib.sld b/lib/xlib.sld new file mode 100644 index 0000000..4206a86 --- /dev/null +++ b/lib/xlib.sld @@ -0,0 +1,4 @@ +(module (acdwm xlib) () + (import scheme (chicken base) (chicken module)) + (reexport xlib) + (include-relative "xlib.sls")) diff --git a/lib/xlib.sls b/lib/xlib.sls new file mode 100644 index 0000000..a1915c5 --- /dev/null +++ b/lib/xlib.sls @@ -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--! out (xevent--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_ => > + (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)))) -- cgit 1.4.1-21-gabe81