better display, extra info for v350.4

svn: r3621

collects/tests/mred/showkey.ss

@@ -3,23 +3,25 @@
 	 (lib "class100.ss"))
 
 (let ()
+  (define iter 0)
   (define c%
        (class100-asi canvas%
 	 (override
 	   [on-event
 	    (lambda (ev)
-	      (printf "~aMOUSE ~a (~a,~a)~n  meta: ~a  control: ~a  alt: ~a  shift: ~a~n  buttons: ~a ~a ~a~a~a~a~a~n" 
+	      (printf "~a~a MOUSE ~a (~a,~a)\n  mods:~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)
-		      (send ev get-meta-down)
+		      (if (send ev get-meta-down) " META" "")
-		      (send ev get-control-down)
+		      (if (send ev get-control-down) " CTL" "")
-		      (send ev get-alt-down)
+		      (if (send ev get-alt-down) " ALT" "")
-		      (send ev get-shift-down)
+		      (if (send ev get-shift-down) " SHIFT" "")
-		      (send ev get-left-down)
+		      (if (send ev get-left-down) " LEFT" "")
-		      (send ev get-middle-down)
+		      (if (send ev get-middle-down) " MIDDLE" "")
-		      (send ev get-right-down)
+		      (if (send ev get-right-down) " RIGHT" "")
 		      (if (send ev dragging?)
 			  " dragging"
 			  "")
@@ -34,20 +36,27 @@
 			  "")))]
 	   [on-char
 	    (lambda (ev)
-	      (printf "~aKEY code: ~a  rel-code: ~a~n  meta: ~a  control: ~a  alt: ~a  shift: ~a~n" 
+	      (set! iter (add1 iter))
+	      (printf "~a~a KEY: ~a\n  rel-code: ~a\n  other-code: ~a\n  mods:~a~a~a~a~n" 
 		      (es-check)
+		      iter
 		      (let ([v (send ev get-key-code)])
 			(if (symbol? v)
 			    v
-			    (format "~a = ASCII ~a" v (char->integer v))))
+			    (format "~s = ASCII ~a" (string v) (char->integer v))))
 		      (let ([v (send ev get-key-release-code)])
 			(if (symbol? v)
 			    v
-			    (format "~a = ASCII ~a" v (char->integer v))))
+			    (format "~s = ASCII ~a" (string v) (char->integer v))))
-		      (send ev get-meta-down)
+		      (let ([v (send ev get-other-shift-key-code)])
-		      (send ev get-control-down)
+			(and v
-		      (send ev get-alt-down)
+			     (if (symbol? v)
-		      (send ev get-shift-down)))])))
+				 v
+				 (format "~s = ASCII ~a" (string v) (char->integer v)))))
+		      (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" "")))])))
   (define f (make-object (class100 frame% ()
                            (inherit accept-drop-files)
                            (override
@@ -59,7 +68,7 @@
   (define c (make-object c% f))
   (define (es-check) (if (eq? (send f get-eventspace) (current-eventspace))
 			 ""
-			 ">>WRONG EVENTSPACE<< "))
+			 ">>WRONG EVENTSPACE<<\n"))
   (send c focus)
   (send f show #t))