From 2a43c68dd7d5909c48f99079cb104cdcec8c5d8f Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@ccs.neu.edu>
Date: Sun, 16 Oct 2011 16:31:50 -0400
Subject: [PATCH] on-release works without on-key; Closes PR12291 please
 propagate

---
 collects/2htdp/private/world.rkt           | 11 +++++-----
 collects/2htdp/tests/on-release-no-key.rkt | 24 ++++++++++++++++++++++
 collects/2htdp/universe.rkt                |  2 +-
 collects/2htdp/xtest                       |  1 +
 4 files changed, 32 insertions(+), 6 deletions(-)
 create mode 100644 collects/2htdp/tests/on-release-no-key.rkt

diff --git a/collects/2htdp/private/world.rkt b/collects/2htdp/private/world.rkt
index 30a3e66e13..6216029528 100644
--- a/collects/2htdp/private/world.rkt
+++ b/collects/2htdp/private/world.rkt
@@ -52,8 +52,8 @@
     (class* object% (start-stop<%>)
       (inspect #f)
       (init-field world0)
-      (init-field name state register check-with on-key on-mouse record?)
-      (init on-release on-receive on-draw stop-when)
+      (init-field name state register check-with on-key on-release on-mouse record?)
+      (init on-receive on-draw stop-when)
       
       ;; -----------------------------------------------------------------------
       (field
@@ -152,7 +152,8 @@
           (show fst-scene)))
       
       (define/public (deal-with-key %)
-        (if (not on-key) %
+        (if (and (not on-key) (not on-release))
+            %
             (class %
               (super-new)
               (define/override (on-char e) 
@@ -235,8 +236,8 @@
       ;; ----------------------------------------------------------------------
       ;; callbacks 
       (field
-       (key    on-key)
-       (release on-release)
+       (key     (if on-key on-key (lambda (w ke) w)))
+       (release (if on-release on-release (lambda (w ke) w)))
        (mouse  on-mouse)
        (rec    on-receive))
       
diff --git a/collects/2htdp/tests/on-release-no-key.rkt b/collects/2htdp/tests/on-release-no-key.rkt
new file mode 100644
index 0000000000..47eeadab58
--- /dev/null
+++ b/collects/2htdp/tests/on-release-no-key.rkt
@@ -0,0 +1,24 @@
+;; The first three lines of this file were inserted by DrRacket. They record metadata
+;; about the language level of this file in a form that our tools can easily process.
+#reader(lib "htdp-advanced-reader.ss" "lang")((modname on-release-no-key) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ())))
+;; Any key inflates the balloon
+
+(require 2htdp/image) 
+(require 2htdp/universe)
+
+(define large 50)
+
+(define (balloon b) 
+  (if (<= b 10)
+      (text "press any key now" 22 'red)
+      (circle b "solid" "red")))
+
+(define (blow-up b k) large)
+
+(define (deflate b) (max (- b 1) 1))
+
+(big-bang 20
+          (on-release blow-up)
+          (on-tick deflate)
+          (to-draw balloon 200 200)
+          (stop-when (lambda (w) (>= w large))))
diff --git a/collects/2htdp/universe.rkt b/collects/2htdp/universe.rkt
index 01fb94b1dc..381773d2db 100644
--- a/collects/2htdp/universe.rkt
+++ b/collects/2htdp/universe.rkt
@@ -93,7 +93,7 @@
   [on-key DEFAULT #f (function-with-arity 2)]
   ;; World KeyEvent -> World 
   ;; on-release must specify a release event handler 
-  [on-release DEFAULT #'K (function-with-arity 2)]
+  [on-release DEFAULT #f (function-with-arity 2)]
   ;; (U #f (World S-expression -> World))
   ;; -- on-receive must specify a receive handler 
   [on-receive DEFAULT #'#f (function-with-arity 2)]
diff --git a/collects/2htdp/xtest b/collects/2htdp/xtest
index 52553b9325..2efd7d3556 100755
--- a/collects/2htdp/xtest
+++ b/collects/2htdp/xtest
@@ -35,4 +35,5 @@ run record-stop-when.rkt
 run stop-when-crash.rkt
 run on-tick-universe-with-limit.rkt
 run on-tick-with-limit.rkt
+run on-release-no-key.rkt