(define-module (wm) #:use-module (ice-9 match) #:use-module (srfi srfi-9) #:use-module (system foreign) #:export (wm-init make-config wm-reconfigure make-key make-shift-key wm-grab-keys wm-grab-key-with-mod wm-grab-key-with-mod-shift wm-set-key-press-handler! wm-exec-cmd wm-focus-prev wm-focus-next wm-focus-close wm-pack-left wm-pack-right wm-pack-top wm-pack-bottom wm-toggle-maximize wm-toggle-half-left wm-toggle-half-right wm-toggle-half-top wm-toggle-half-bottom wm-toggle-top-left wm-toggle-top-right wm-toggle-bottom-left wm-toggle-bottom-right wm-set-workspace wm-set-focused-client-workspace wm-client-monitor-prev wm-client-monitor-next wm-run wm-quit)) ;; Configuration record (define-record-type (make-config inner-border-width outer-border-width magnet-border-width offset-x offset-y offset-width offset-height focused-color unfocused-color unkillable-color empty-color outer-color) wm-config? (inner-border-width config-inner-border-width set-config-inner-border-width!) (outer-border-width config-outer-border-width set-config-outer-border-width!) (magnet-border-width config-magnet-border-width set-config-magnet-border-width!) (offset-x config-offset-x set-config-offset-x!) (offset-y config-offset-y set-config-offset-y!) (offset-width config-offset-width set-config-offset-width!) (offset-height config-offset-height set-config-offset-height!) (focused-color config-focused-color set-config-focused-color!) (unfocused-color config-unfocused-color set-config-unfocused-color!) (unkillable-color config-unkillable-color set-config-unkillable-color) (empty-color config-empty-color set-config-empty-color) (outer-color config-outer-color set-config-outer-color)) ;; Misc. utility functions (define (uint8-as-bool i) (not (eq? 0 i))) ;; Link to schewm shared lib (define libschewm (dynamic-link "libschewm")) ;; Helper to easily define calls into schewm C code (define (schewm-func return-type name args) (pointer->procedure return-type (dynamic-func name libschewm) args)) (define c/wm-init (schewm-func uint8 "wm_init" '())) (define (wm-init) (uint8-as-bool (c/wm-init))) (define wm-quit (schewm-func void "wm_quit" '())) (define wm-run (schewm-func void "wm_run" '())) (define c/parse-color (schewm-func uint32 "parse_color" (list '*))) (define (parse-color s) (c/parse-color (string->pointer s))) (define c/wm-reconfigure (schewm-func void "wm_reconfigure" (list uint16 uint16 uint16 int16 int16 uint16 uint16 uint32 uint32 uint32 uint32 uint32))) (define (wm-reconfigure config) (c/wm-reconfigure (config-inner-border-width config) (config-outer-border-width config) (config-magnet-border-width config) (config-offset-x config) (config-offset-y config) (config-offset-width config) (config-offset-height config) (parse-color (config-focused-color config)) (parse-color (config-unfocused-color config)) (parse-color (config-unkillable-color config)) (parse-color (config-empty-color config)) (parse-color (config-outer-color config)))) (define wm-focus-prev (schewm-func void "wm_focus_prev" '())) (define wm-focus-next (schewm-func void "wm_focus_next" '())) (define wm-focus-close (schewm-func void "wm_focus_close" '())) (define wm-pack-left (schewm-func void "wm_pack_left" '())) (define wm-pack-right (schewm-func void "wm_pack_right" '())) (define wm-pack-top (schewm-func void "wm_pack_top" '())) (define wm-pack-bottom (schewm-func void "wm_pack_bottom" '())) (define wm-toggle-maximize (schewm-func void "wm_toggle_maximize" '())) (define wm-toggle-half-left (schewm-func void "wm_toggle_half_left" '())) (define wm-toggle-half-right (schewm-func void "wm_toggle_half_right" '())) (define wm-toggle-half-top (schewm-func void "wm_toggle_half_top" '())) (define wm-toggle-half-bottom (schewm-func void "wm_toggle_half_bottom" '())) (define wm-toggle-top-left (schewm-func void "wm_toggle_top_left" '())) (define wm-toggle-top-right (schewm-func void "wm_toggle_top_right" '())) (define wm-toggle-bottom-left (schewm-func void "wm_toggle_bottom_left" '())) (define wm-toggle-bottom-right (schewm-func void "wm_toggle_bottom_right" '())) (define wm-set-workspace (schewm-func void "wm_set_workspace" (list uint32))) (define wm-set-focused-client-workspace (schewm-func void "wm_set_focused_client_workspace" (list uint32))) (define wm-client-monitor-prev (schewm-func void "wm_client_monitor_prev" '())) (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)))) (define (wm-exec-cmd . args) (when (eq? (primitive-fork) 0) (apply execlp (cons (car args) args))))