102 lines
2.9 KiB
Scheme
102 lines
2.9 KiB
Scheme
(define-module (gri3 bindings)
|
|
#:use-module (gri3 wm)
|
|
#:use-module (gri3 hooks)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (ice-9 match)
|
|
#:export (define-mode-map add-key-binding kbd key-press-hook clear-bindings))
|
|
|
|
(define *bindings* '())
|
|
(define *mode-map* '())
|
|
(define *mode* "default")
|
|
|
|
(define (sym->name sym)
|
|
(or (assoc-ref
|
|
'(("\r" . "Return")
|
|
(" " . "space"))
|
|
sym)
|
|
sym))
|
|
|
|
(define (key-press-hook param)
|
|
(let ((param (list (list-ref param 0) (list-ref param 1) (sym->name (list-ref param 2)))))
|
|
(apply format #t "~A ~A ~s\n" param)
|
|
;; (display *bindings*)
|
|
;; (newline)
|
|
(let ((binding (assoc-ref
|
|
*bindings* (list *mode* param))))
|
|
;; (display binding)
|
|
;; (newline)
|
|
(if binding
|
|
(begin (binding)
|
|
#t)
|
|
#f))))
|
|
|
|
(define (notify-exceptions exc)
|
|
(system (format #f "notify-send exception ~A" exc)))
|
|
|
|
(define (key-press-hook param)
|
|
(with-exception-handler notify-exceptions key-press-hook-real #:unwind? #t))
|
|
|
|
(define (clear-bindings) (set! *bindings* '()))
|
|
|
|
(define (add-key-binding key func)
|
|
(match-let (((mode (press mod keysym)) key))
|
|
;; (format #t "Binding key ~A\n" keysym)
|
|
;; get notified for key with all mods
|
|
(for-each (lambda (mod) (bind-key keysym mod)) (list #x8 #x10 #x26 #x40))
|
|
;; Store the key+func couple in the list of hooks
|
|
(set! *bindings* (assoc-set! *bindings* `("default" (,press ,mod ,keysym)) func))))
|
|
|
|
(define (special->keysym name)
|
|
(or (assoc-ref
|
|
'( ;; ("NUL")
|
|
;; ("REM")
|
|
("RET" . "Return")
|
|
("TAB" . "Tab")
|
|
("LFD" . "Linefeed")
|
|
("ESC" . "Escape")
|
|
("SPC" . "space")
|
|
("DEL" . "Delete"))
|
|
name)
|
|
name))
|
|
|
|
(define (define-mode-map map mode)
|
|
(set! *mode-map* (append *mode-map* `((,map . ,mode)))))
|
|
|
|
;; modifiers
|
|
;; ("A" "C" "M" "H" "s" "S")
|
|
(define *modifiers*
|
|
;; Where's H?
|
|
'(("S" . #b00000001)
|
|
("L" . #b00000010)
|
|
("C" . #b00000100)
|
|
("M" . #b00001000)
|
|
("mod2" . #b00010000)
|
|
("mod3" . #b00100000)
|
|
("s" . #b01000000)
|
|
("mod5" . #b10000000)))
|
|
|
|
(define (mod->int mod)
|
|
(assoc-ref *modifiers* mod))
|
|
|
|
(define *key-press* 2)
|
|
|
|
;; TODO: Support multiple modifiers! Sum their int value
|
|
(define (kbd keys)
|
|
"Convert keys in our own representation. KEYS should be a string compatible
|
|
with the emacs format such as `C-h k'."
|
|
(match (let ((keys (string-split keys #\space)))
|
|
(map (lambda (key) (string-split key #\-)) keys))
|
|
(((M1 mode) (M2 key)) `((,M1 ,mode) (,*key-press* ,(mod->int M2) ,(special->keysym key))))
|
|
(((M mode) (key)) `((,M ,mode) (,*key-press* 0 ,(special->keysym key))))
|
|
(((M1 M2 key)) `(("") (,*key-press* ,(+ (mod->int M1) (mod->int M2)) ,(special->keysym key))))
|
|
(((M key)) `(("") (,*key-press* ,(mod->int M) ,(special->keysym key))))
|
|
(((key)) `(("") (,*key-press* 0 ,(special->keysym key))))
|
|
(else (display "Cannot parse kdb"))))
|
|
|
|
;; (kbd "C-RET C-k")
|
|
;; (kbd "C-RET C-k")
|
|
;; (kbd "C-RET k")
|
|
;; (kbd "C-S-1")
|
|
;; (kbd "C-h")
|
|
;; (kbd "C")
|