..

original commit: 36eaf715737914b8f1ed07c64efbbcd813de0291

collects/framework/private/scheme.ss

@@ -47,7 +47,7 @@
         (opt-lambda (text [start 0] [in-end #f])
           (let* ([end (or in-end (send text last-position))]
                  [port (open-input-text-editor text start end)])
-            (with-handlers ([exn:read:eof? (lambda (x) #f)])
+            (with-handlers ([exn:read? (lambda (x) #f)])
               (let loop ()
                 (let ([s (read port)])
                   (or (eof-object? s)

collects/mred/private/seqcontract.ss

@@ -78,7 +78,12 @@
                                      (with-syntax ([call (if (identifier? arity)
                                                              (syntax (super-method-name . formals))
                                                              (with-syntax ([(x ...) arity])
-                                                               (syntax (super-method-name x ...))))])
+                                                               (syntax (super-method-name x ...))))]
+                                                   [args-as-list
+                                                    (if (identifier? arity)
+                                                        arity
+                                                        (with-syntax ([(x ...) arity])
+                                                          (syntax (list x ...))))])
                                        (syntax
                                         [formals
                                          (cond
@@ -102,15 +107,12 @@
                                            [else
                                             (sequence-contract-violation 
                                              'negative
-                                             "method ~s cannot be called, except in states ~s, current state: ~s"
+                                             "method ~s cannot be called, except in states ~s, current state: ~s~a"
                                              'method-name
                                              '(state-name ...)
-                                             (let loop ([l (list (list 'all-state-names (all-predicate-names)) ...)])
-                                               (cond
-                                                 [(null? l) '<<unknown-state>>]
-                                                 [else (if (cadr (car l))
-                                                           (car (car l))
-                                                           (loop (cdr l)))])))])]))))
+                                             (find-current-state 
+                                              (list (list 'all-state-names (all-predicate-names)) ...))
+                                             (format-args args-as-list))])]))))
                                  (syntax->list (state-desc-arities (car state-descs))))])
                (syntax
                 (begin
@@ -169,6 +171,29 @@
                 (define/private predicate-names (lambda () exp)) ...
                 overriding-method ... 
                 clauses ...)))))]))
+  
+  (define (format-args l)
+    (cond
+      [(null? l) ""]
+      [else
+       (string-append
+        ", args "
+        (let loop ([fst (car l)]
+                   [rst (cdr l)])
+          (cond
+            [(null? rst) (format "~e" fst)]
+            [else (string-append
+                   (format "~e" fst)
+                   " "
+                   (loop (car rst) (cdr rst)))])))]))
+  
+  (define (find-current-state l)
+    (let loop ([l l])
+      (cond
+        [(null? l) '<<unknown-state>>]
+        [else (if (cadr (car l))
+                  (car (car l))
+                  (loop (cdr l)))])))
 
   (define (sequence-contract-violation dir fmt . args)
     (apply error