A working callback mechanism between C and Scheme code.

Callbacks can be fully setup via Scheme code; the C code assumes
callbacks have no args and return no values. Within Scheme we setup
callbacks via some lambda functions that capture args when needed (see
make-callback example).

Key press handler operates on the C side using a hash map to find the
callback to be called. Everything is set up on the Scheme side, which
is less verbose and more convenient to read.

* main.scm: Setup callbacks for keypresses
* schewm.c: Callbacks hash maps for keys and buttons, handlers for
keys
* wm.scm: Minor reorganization (key grab also now takes the callback
directly)

1 files changed, 54 insertions, 48 deletions

diff --git a/wm.scm b/wm.scm
index 3dd4797..a778dae 100644
--- a/wm.scm
+++ b/wm.scm
@@ -1,4 +1,5 @@
 (define-module (wm)
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-9)
   #:use-module (system foreign)
   #:export (wm-init
@@ -87,54 +88,6 @@
 (define wm-run
   (schewm-func void "wm_run" '()))
 
-(define c/keysym-from-str
-  (schewm-func uint32
-               "keysym_from_str"
-               (list '*)))
-
-(define (string->key s)
-  (c/keysym-from-str (string->pointer s)))
-
-(define (make-key key)
-  (list #f (string->key key)))
-
-(define (make-shift-key key)
-  (list #t (string->key key)))
-
-(define wm-grab-key-with-mod
-  (schewm-func void "wm_grab_key_with_mod"
-               (list uint32)))
-
-(define wm-grab-key-with-mod-shift
-  (schewm-func void "wm_grab_key_with_mod_shift"
-               (list uint32)))
-
-(define (wm-grab-keys keybindings)
-  (unless (null? keybindings)
-    (let* ((keybinding (car keybindings))
-           (chord (car keybinding))
-           (func (cdr keybinding))
-           (with-shift (car chord))
-           (key (car (cdr chord))))
-      (if with-shift
-          (wm-grab-key-with-mod-shift key)
-          (wm-grab-key-with-mod key))
-      (wm-grab-keys (cdr keybindings)))))
-
-(define c/wm-set-key-press-handler
-  (schewm-func void
-               "wm_set_key_press_handler"
-               (list '*)))
-
-(define (wm-set-key-press-handler! handler)
-  ;; Event handler args are:
-  ;; - mod (`ev.state' clean from noise, uint16)
-  ;; - keysym (`ev.detail' converted to keysym, uint32)
-  (c/wm-set-key-press-handler
-   (procedure->pointer void
-                       handler
-                       (list uint16 uint32))))
-
 (define wm-focus-prev
   (schewm-func void "wm_focus_prev" '()))
 
@@ -198,3 +151,56 @@
 
 (define wm-client-monitor-next
   (schewm-func void "wm_client_monitor_next" '()))
+
+
+(define c/keysym-from-str
+  (schewm-func uint32
+               "keysym_from_str"
+               (list '*)))
+
+(define (string->key s)
+  (c/keysym-from-str (string->pointer s)))
+
+(define (make-key key)
+  (list #f (string->key key)))
+
+(define (make-shift-key key)
+  (list #t (string->key key)))
+
+(define c/wm-grab-key-with-mod
+  (schewm-func void "wm_grab_key_with_mod"
+               (list uint32 '*)))
+
+(define (wm-grab-key-with-mod key proc)
+  (c/wm-grab-key-with-mod key (procedure->pointer void proc '())))
+
+(define c/wm-grab-key-with-mod-shift
+  (schewm-func void "wm_grab_key_with_mod_shift"
+               (list uint32 '*)))
+
+(define (wm-grab-key-with-mod-shift key proc)
+  (c/wm-grab-key-with-mod-shift key (procedure->pointer void proc '())))
+
+(define (wm-grab-keys keybindings)
+  (unless (null? keybindings)
+    (let ((keybinding (car keybindings)))
+      (match keybinding
+             (((with-shift key) . func)
+              (if with-shift
+                  (wm-grab-key-with-mod-shift key func)
+                  (wm-grab-key-with-mod key func))))
+      (wm-grab-keys (cdr keybindings)))))
+
+(define c/wm-set-key-press-handler
+  (schewm-func void
+               "wm_set_key_press_handler"
+               (list '*)))
+
+(define (wm-set-key-press-handler! handler)
+  ;; Event handler args are:
+  ;; - mod (`ev.state' clean from noise, uint16)
+  ;; - keysym (`ev.detail' converted to keysym, uint32)
+  (c/wm-set-key-press-handler
+   (procedure->pointer void
+                       handler
+                       (list uint16 uint32))))