diff --git a/collects/tests/gracket/showkey.rkt b/collects/tests/gracket/showkey.rkt
new file mode 100644
index 00000000..64de9155
--- /dev/null
+++ b/collects/tests/gracket/showkey.rkt
@@ -0,0 +1,77 @@
+#lang racket/base
+(require racket/gui/base
+         racket/class)
+
+(let ()
+  (define iter 0)
+  (define c%
+    (class canvas%
+      (super-new)
+      (define/override (on-event ev)
+        (lambda (ev)
+          (printf "~a~a MOUSE ~a (~a,~a)\n  mods:~a~a~a~a~a\n  buttons:~a~a~a~a~a~a~a\n" 
+                  (es-check)
+                  iter
+                  (send ev get-event-type)
+                  (send ev get-x)
+                  (send ev get-y)
+                  (if (send ev get-meta-down) " META" "")
+                  (if (send ev get-control-down) " CTL" "")
+                  (if (send ev get-alt-down) " ALT" "")
+                  (if (send ev get-shift-down) " SHIFT" "")
+                  (if (send ev get-caps-down) " CAPS" "")
+                  (if (send ev get-left-down) " LEFT" "")
+                  (if (send ev get-middle-down) " MIDDLE" "")
+                  (if (send ev get-right-down) " RIGHT" "")
+                  (if (send ev dragging?)
+                      " dragging"
+                      "")
+                  (if (send ev moving?)
+                      " moving"
+                      "")
+                  (if (send ev entering?)
+                      " entering"
+                      "")
+                  (if (send ev leaving?)
+                      " leaving"
+                      ""))))
+      (define/override (on-char ev)
+        (set! iter (add1 iter))
+        (printf "~a~a KEY: ~a\n  rel-code: ~a\n  other-codes: ~a\n  mods:~a~a~a~a~a\n" 
+                (es-check)
+                iter
+                (let ([v (send ev get-key-code)])
+                  (if (symbol? v)
+                      v
+                      (format "~s = ASCII ~a" (string v) (char->integer v))))
+                (let ([v (send ev get-key-release-code)])
+                  (if (symbol? v)
+                      v
+                      (format "~s = ASCII ~a" (string v) (char->integer v))))
+                (let ([vs (list (send ev get-other-shift-key-code)
+                                (send ev get-other-altgr-key-code)
+                                (send ev get-other-shift-altgr-key-code)
+                                (send ev get-other-caps-key-code))])
+                  (map (lambda (v)
+                         (and v
+                              (if (symbol? v)
+                                  v
+                                  (format "~s = ASCII ~a" (string v) (char->integer v)))))
+                       vs))
+                (if (send ev get-meta-down) " META" "")
+                (if (send ev get-control-down) " CTL" "")
+                (if (send ev get-alt-down) " ALT" "")
+                (if (send ev get-shift-down) " SHIFT" "")
+                (if (send ev get-caps-down) " CAPS" "")))))
+  (define f (make-object (class frame%
+                           (inherit accept-drop-files)
+                           (define/override (on-drop-file file)
+                             (printf "Dropped: ~a\n" file))
+                           (super-make-object  "tests" #f 100 100)
+                           (accept-drop-files #t))))
+  (define c (make-object c% f))
+  (define (es-check) (if (eq? (send f get-eventspace) (current-eventspace))
+			 ""
+			 ">>WRONG EVENTSPACE<<\n"))
+  (send c focus)
+  (send f show #t))