From 1700827a7f4694375226faffcc466709ec8c79d9 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 26 Oct 2022 20:42:57 -0400 Subject: kernel: Fix global input binding. --- catbird.scm | 2 +- catbird/kernel.scm | 21 +++++++++++---------- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/catbird.scm b/catbird.scm index 9279cdb..417cadb 100644 --- a/catbird.scm +++ b/catbird.scm @@ -53,7 +53,7 @@ (define (open-minibuffer) (push-major-mode (overlay-scene) (make ))) -;;(bind-input/global (key-press 'x '(alt)) open-minibuffer) +(bind-input/global (key-press 'x '(alt)) open-minibuffer) (define* (run-catbird thunk #:key (width 1366) (height 768) (title "^~Catbird~^") (fullscreen? #f) diff --git a/catbird/kernel.scm b/catbird/kernel.scm index de2fb3d..bbdb9fe 100644 --- a/catbird/kernel.scm +++ b/catbird/kernel.scm @@ -62,7 +62,8 @@ (define-root-class () (controllers #:getter controllers #:init-thunk make-array-list) (regions #:accessor regions #:init-value '()) - (input-map #:accessor input-map #:init-thunk make-input-map) + (input-map #:accessor input-map #:init-thunk make-input-map + #:allocation #:class) (keyboard-focus #:accessor keyboard-focus #:init-value #f) (controller-focus #:getter controller-focus #:init-thunk make-hash-table) (repl #:accessor repl #:init-value #f) @@ -107,12 +108,6 @@ (set! (regions kernel) (sort-by-rank/ascending (cons region (regions kernel)))))) -(define-method (bind-input (kernel ) spec handler) - (set! (input-map kernel) (add-input (input-map kernel) spec handler))) - -(define-method (unbind-input (kernel ) spec) - (set! (input-map kernel) (remove-input (input-map kernel) spec))) - (define-generic notify) @@ -330,8 +325,14 @@ (define (take-controller-focus controller-id region) (hashv-set! (controller-focus (current-kernel)) controller-id region)) +(define (global-input-map) + (class-slot-ref 'input-map)) + +(define (global-input-map-set! input-map) + (class-slot-set! 'input-map input-map)) + (define (bind-input/global spec handler) - (bind-input (current-kernel) spec handler)) + (global-input-map-set! (add-input (global-input-map) spec handler))) -(define (unbind-input/global spec handler) - (unbind-input (current-kernel) spec handler)) +(define (unbind-input/global spec) + (global-input-map-set! (remove-input (global-input-map) spec))) -- cgit v1.2.3