make to-draw (alt-kw) error messages more correct, see test for flaws; closes PR 14781

please merge with 6.1.1

pkgs/htdp-pkgs/htdp-lib/2htdp/private/define-keywords.rkt

@@ -28,7 +28,10 @@
            (provide (rename-out (kw  kw-alt) ...))
            (provide kw ...) 
            (define-syntaxes (kw ...)
-             (values (lambda (x) (raise-syntax-error 'kw "used out of context" x)) ...))
+             (values
+              (lambda (x)
+                (raise-syntax-error (if (equal? 'kw x) 'kw 'kw-alt) "used out of context" x))
+              ...))
            
            ;; a macro for creating functions that instantiate the proper object
            ;; (define-create para ...) :: additional parameters for the new func
@@ -46,3 +49,10 @@
                         (lambda #,(args para*)
                           (lambda ()
                             (new % #,@(body para*)))))))]))))]))
+
+#;
+(define-keywords 
+  new-world
+  '()
+  define-create
+  (on-draw to-draw DEFAULT #'#f values))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-to-draw.rkt

@@ -0,0 +1,21 @@
+#lang racket 
+
+;; fixes PR 14781
+
+(define-namespace-anchor an)
+
+(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)
+   (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 

pkgs/htdp-pkgs/htdp-test/2htdp/xtest

@@ -18,6 +18,7 @@ run run-movie.rkt
 run bad-draw.rkt
 run error-in-tick.rkt
 run error-in-draw.rkt
+run error-to-draw.rkt
 run -t batch-io.rkt
 run -t batch-io2.rkt
 run -t batch-io3.rkt