From 923a785867a3d9082da99d3187398fe772a6c5df Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@ccs.neu.edu>
Date: Tue, 21 Oct 2014 12:09:25 -0400
Subject: [PATCH] improved fix, Matthew's suggestion

please merge into 6.1.1
---
 .../2htdp/private/define-keywords.rkt         | 12 +----
 .../htdp-test/2htdp/tests/error-to-draw.rkt   | 52 +++++++++++++++++--
 2 files changed, 51 insertions(+), 13 deletions(-)

diff --git a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/define-keywords.rkt b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/define-keywords.rkt
index 1dffe64fd8..b41b8b8416 100644
--- a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/define-keywords.rkt
+++ b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/define-keywords.rkt
@@ -29,8 +29,7 @@
            (provide kw ...) 
            (define-syntaxes (kw ...)
              (values
-              (lambda (x)
-                (raise-syntax-error (if (equal? 'kw x) 'kw 'kw-alt) "used out of context" x))
+              (lambda (x) 'kw (raise-syntax-error #f "used out of context" x))
               ...))
            
            ;; a macro for creating functions that instantiate the proper object
@@ -48,11 +47,4 @@
                     #`(lambda (%)
                         (lambda #,(args para*)
                           (lambda ()
-                            (new % #,@(body para*)))))))]))))]))
-
-#;
-(define-keywords 
-  new-world
-  '()
-  define-create
-  (on-draw to-draw DEFAULT #'#f values))
\ No newline at end of file
+                            (new % #,@(body para*)))))))]))))]))
\ No newline at end of file
diff --git a/pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-to-draw.rkt b/pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-to-draw.rkt
index ee3dd5a94b..a7a139a793 100644
--- a/pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-to-draw.rkt
+++ b/pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-to-draw.rkt
@@ -16,6 +16,52 @@
    (namespace-anchor->namespace an))
   (error 'to-draw "got no error message"))
 
-;; known problem with the solution: 
-;;    (to-draw on-draw)
-;; will signal the wrong kind of error 
+(with-handlers ([exn:fail:syntax? 
+                 ;; succeed quietly if 
+                 (lambda (x)
+                   (unless (regexp-match? "^to-draw" (exn-message x))
+                     (error 'to-draw "got wrong error message: ~e" (exn-message x))))])
+  (eval
+   '(module test racket
+      (require 2htdp/universe)
+      (to-draw on-draw))
+   (namespace-anchor->namespace an))
+  (error 'to-draw "got no error message"))
+
+(with-handlers ([exn:fail:syntax? 
+                 ;; succeed quietly if 
+                 (lambda (x)
+                   (unless (regexp-match? "^to-draw" (exn-message x))
+                     (error 'to-draw "got wrong error message: ~e" (exn-message x))))])
+  (eval
+   '(module test racket
+      (require 2htdp/universe)
+      (big-bang 0 (on-draw to-draw)))
+   (namespace-anchor->namespace an))
+  (error 'to-draw "got no error message"))
+
+;; it still works okay for on-draw 
+
+(with-handlers ([exn:fail:syntax? 
+                 ;; succeed quietly if 
+                 (lambda (x)
+                   (unless (regexp-match? "^on-draw" (exn-message x))
+                     (error 'on-draw "got wrong error message: ~e" (exn-message x))))])
+  (eval
+   '(module test racket
+      (require 2htdp/universe)
+      (on-draw to-draw))
+   (namespace-anchor->namespace an))
+  (error 'on-draw "got no error message"))
+
+(with-handlers ([exn:fail:syntax? 
+                 ;; succeed quietly if 
+                 (lambda (x)
+                   (unless (regexp-match? "^on-draw" (exn-message x))
+                     (error 'on-draw "got wrong error message: ~e" (exn-message x))))])
+  (eval
+   '(module test racket
+      (require 2htdp/universe)
+      (big-bang 0 (to-draw on-draw)))
+   (namespace-anchor->namespace an))
+  (error 'to-draw "got no error message"))
\ No newline at end of file