diff options
| author | David Thompson <dthompson@vistahigherlearning.com> | 2022-10-26 20:42:57 -0400 |
|---|---|---|
| committer | David Thompson <dthompson@vistahigherlearning.com> | 2022-10-26 20:42:57 -0400 |
| commit | 1700827a7f4694375226faffcc466709ec8c79d9 (patch) | |
| tree | 2da046527055988b9a27299ad81b6dbe36ae59e9 | |
| parent | 619d33533e3029ffcb9e670db7cc136f074a51f1 (diff) | |
kernel: Fix global input binding.
| -rw-r--r-- | catbird.scm | 2 | ||||
| -rw-r--r-- | 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 <minibuffer-mode>))) -;;(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 <kernel> () (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 <kernel>) spec handler) - (set! (input-map kernel) (add-input (input-map kernel) spec handler))) - -(define-method (unbind-input (kernel <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 <kernel> 'input-map)) + +(define (global-input-map-set! input-map) + (class-slot-set! <kernel> '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))) |