diff --git a/collects/racket/contract/private/base.rkt b/collects/racket/contract/private/base.rkt
index 293b66f0a1..14f71a3b04 100644
--- a/collects/racket/contract/private/base.rkt
+++ b/collects/racket/contract/private/base.rkt
@@ -27,21 +27,21 @@ improve method arity mismatch contract violation error messages?
   (syntax-case stx ()
     [(_ c v pos neg name loc)
      (syntax/loc stx
-       (apply-contract c v pos neg name loc))]
+       (apply-contract c v pos neg name loc (current-contract-region)))]
     [(_ c v pos neg)
      (syntax/loc stx
-       (apply-contract c v pos neg #f (build-source-location #f)))]
+       (apply-contract c v pos neg #f (build-source-location #f) (current-contract-region)))]
     [(_ c v pos neg src)
      (raise-syntax-error 'contract
        (string-append
         "please update contract application to new protocol "
         "(either 4 or 6 arguments)"))]))
 
-(define (apply-contract c v pos neg name loc)
+(define (apply-contract c v pos neg name loc usr)
   (let* ([c (coerce-contract 'contract c)])
     (check-source-location! 'contract loc)
     (((contract-projection c)
-      (make-blame loc name (contract-name c) pos neg #t))
+      (make-blame loc name (contract-name c) pos neg usr #t))
      v)))
 
 (define-syntax (recursive-contract stx)
diff --git a/collects/racket/contract/private/blame.rkt b/collects/racket/contract/private/blame.rkt
index a0311aa122..5e6f106965 100644
--- a/collects/racket/contract/private/blame.rkt
+++ b/collects/racket/contract/private/blame.rkt
@@ -34,7 +34,7 @@
                (hash/recur (blame-original? b))))
 
 (define-struct blame
-  [source value contract positive negative original?]
+  [source value contract positive negative user original?]
   #:property prop:equal+hash
   (list blame=? blame-hash blame-hash))
 
@@ -64,12 +64,17 @@
          [contract-message (show/write (blame-contract b))]
          [value-message (if (blame-value b)
                           (format " on ~a" (show/display (blame-value b)))
-                          "")])
-    (format "~a~a broke the contract ~a~a; ~a"
+                          "")]
+         [user-message (if (or (blame-original? b)
+                               (equal? (blame-positive b) (blame-user b)))
+                           ""
+                           (format " given to ~a" (show/display (blame-user b))))])
+    (format "~a~a broke the contract ~a~a~a; ~a"
             source-message
             positive-message
             contract-message
             value-message
+            user-message
             custom-message)))
 
 (define ((show f) v)
diff --git a/collects/racket/contract/private/legacy.rkt b/collects/racket/contract/private/legacy.rkt
index 5b80fbbe46..d912b62e41 100644
--- a/collects/racket/contract/private/legacy.rkt
+++ b/collects/racket/contract/private/legacy.rkt
@@ -21,7 +21,8 @@
                      name
                      (unpack-blame pos)
                      "<<unknown party>>"
-                     #t)
+                     #t
+                     name)
          x
          fmt
          args))
@@ -58,7 +59,8 @@
                         name
                         (unpack-blame (if original? pos neg))
                         (unpack-blame (if original? neg pos))
-                        original?)))))
+                        original? 
+                        name)))))
 
 (define (legacy-property name)
   (define-values [ prop pred get ]