record full keyboard state in a racket/gui window

keystate.rkt

#lang racket/base
(require racket/gui/base
         racket/class
         racket/pretty)

(struct keyboard-state (alt-down? shift-down? control-down? meta-down? caps-down?
                            keys-down)
  #:inspector (make-inspector))

;; Try to record the state of the keymap by watching on-subwindow-char
(define (capturing-keystate window%)
  (class window%
    (super-new)
    (define alt-down? #f)
    (define shift-down? #f)
    (define control-down? #f)
    (define meta-down? #f)
    (define caps-down? #f)
    
    (define keys-down (make-hash))
    
    (define/public (get-keyboard-state)
      (keyboard-state alt-down? shift-down? control-down? meta-down? caps-down? keys-down))
    
    ;; Monitor each event, and keep track in our own personal keymap.
    (define/override (on-subwindow-char receiver key-event)
      (define keycode (send key-event get-key-code))
      (cond
        [(eq? keycode 'release)
         (define released-key (send key-event get-key-release-code))
         (hash-remove! keys-down released-key)]
        [else
         (hash-set! keys-down keycode #t)])
      (set! alt-down? (send key-event get-alt-down))
      (set! caps-down? (send key-event get-caps-down))
      (set! control-down? (send key-event get-control-down))
      (set! meta-down? (send key-event get-meta-down))
      (set! shift-down? (send key-event get-shift-down))
      
      (super on-subwindow-char receiver key-event))))


(define (test)
  (define myframe (new (capturing-keystate frame%)
                       [label "Testing"]
                       [width 500]
                       [height 500]))
  (define textarea (new text%))
  (define canvas (new editor-canvas% [parent myframe] [editor textarea]))
  (send myframe show #t)
  (thread (lambda ()
            (let loop ()
              (send textarea begin-edit-sequence)
              (send textarea erase)
              (send textarea insert (pretty-format (send myframe get-keyboard-state)))
              (send textarea end-edit-sequence)
              (sleep 0.1)
              (loop))))
  (void))