From cd2898675f362fd5491da6e7f9aff49fa02bb55c Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 11 Dec 2014 13:31:06 -0600
Subject: [PATCH] add #:name argument to
 {transplant,relocate}-{input,output}-port

---
 .../scribblings/reference/port-lib.scrbl      | 20 +++++++++++++------
 racket/collects/racket/port.rkt               |  9 +++++----
 racket/collects/racket/private/port.rkt       | 13 ++++++------
 3 files changed, 26 insertions(+), 16 deletions(-)

diff --git a/pkgs/racket-doc/scribblings/reference/port-lib.scrbl b/pkgs/racket-doc/scribblings/reference/port-lib.scrbl
index 9222c9f5d1..9a854b3456 100644
--- a/pkgs/racket-doc/scribblings/reference/port-lib.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/port-lib.scrbl
@@ -478,11 +478,12 @@ the result port does not affect writing directly to @racket[out].}
                               [line (or/c exact-positive-integer? #f)]
                               [column (or/c exact-nonnegative-integer? #f)]
                               [position exact-positive-integer?]
-                              [close? any/c #t])
+                              [close? any/c #t]
+                              [#:name name (object-name out)])
          input-port?]{
 
 Produces an input port that is equivalent to @racket[in] except in how
-it reports location information. The resulting port's content starts
+it reports location information (and possibly its name). The resulting port's content starts
 with the remaining content of @racket[in], and it starts at the given
 line, column, and position. A @racket[#f] for the line or column means
 that the line and column will always be reported as @racket[#f].
@@ -501,14 +502,19 @@ not increment when data is read from @racket[in].
 
 If @racket[close?] is true, then closing the resulting port also
 closes @racket[in]. If @racket[close?] is @racket[#f], then closing
-the resulting port does not close @racket[in].}
+the resulting port does not close @racket[in].
+
+The @racket[name] argument is used as the name for the resulting port;
+the default value keeps the same name as @racket[in].
+}
 
 
 @defproc[(relocate-output-port [out output-port?]
                                [line (or/c exact-positive-integer? #f)]
                                [column (or/c exact-nonnegative-integer? #f)]
                                [position exact-positive-integer?]
-                               [close? any/c #t])
+                               [close? any/c #t]
+                               [#:name name (object-name out)])
          output-port?]{
 
 Like @racket[relocate-input-port], but for output ports.}
@@ -524,7 +530,8 @@ Like @racket[relocate-input-port], but for output ports.}
                                                #f)]
                                 [init-pos exact-positive-integer?]
                                 [close? any/c #t]
-                                [count-lines! (-> any) void])
+                                [count-lines! (-> any) void]
+                                [#:name name (object-name out)])
           input-port?]{
 
 Like @racket[relocate-input-port], except that arbitrary position
@@ -547,7 +554,8 @@ is enabled for the resulting port. The default is @racket[void].}
                                                 #f)]
                                  [init-pos exact-positive-integer?]
                                  [close? any/c #t]
-                                 [count-lines! (-> any) void])
+                                 [count-lines! (-> any) void]
+                                 [#:name name (object-name out)])
           output-port?]{
 
 Like @racket[transplant-input-port], but for output ports.}
diff --git a/racket/collects/racket/port.rkt b/racket/collects/racket/port.rkt
index 9ecf4ea51e..ba6b0fd4fe 100644
--- a/racket/collects/racket/port.rkt
+++ b/racket/collects/racket/port.rkt
@@ -607,13 +607,14 @@
    (eq? buffer-mode 'block)))
 
 (define relocate-input-port
-  (lambda (p line col pos [close? #t])
-    (transplant-to-relocate transplant-input-port p line col pos close?)))
+  (lambda (p line col pos [close? #t] #:name [name (object-name p)])
+    (transplant-to-relocate transplant-input-port p line col pos close? name)))
 
 (define transplant-input-port
-  (lambda (p location-proc pos [close? #t] [count-lines!-proc void])
+  (lambda (p location-proc pos [close? #t] [count-lines!-proc void]
+             #:name [name (object-name p)])
     (make-input-port
-     (object-name p)
+     name
      p ;; redirect `read' to `p'
      ;; Here's the long way to redirect:
      #;
diff --git a/racket/collects/racket/private/port.rkt b/racket/collects/racket/private/port.rkt
index 1b62d5ddcc..e5589a8e60 100644
--- a/racket/collects/racket/private/port.rkt
+++ b/racket/collects/racket/private/port.rkt
@@ -30,7 +30,7 @@
           (lambda (special) 
             (wrap-evt always-evt (lambda (x) #t)))))))
 
-(define (transplant-to-relocate transplant p line col pos close?)
+(define (transplant-to-relocate transplant p line col pos close? name)
   (let-values ([(init-l init-c init-p) (port-next-location p)])
     (transplant
      p
@@ -42,18 +42,19 @@
                                    c))
                  (and p init-p (+ p (- init-p) pos)))))
      pos
-     close?)))
+     close?
+     #:name name)))
 
 (define relocate-output-port
-  (lambda (p line col pos [close? #t])
+  (lambda (p line col pos [close? #t] #:name [name (object-name p)])
     (transplant-to-relocate
      transplant-output-port
-     p line col pos close?)))
+     p line col pos close? name)))
 
 (define transplant-output-port
-  (lambda (p location-proc pos [close? #t] [count-lines!-proc void])
+  (lambda (p location-proc pos [close? #t] [count-lines!-proc void] #:name [name (object-name p)])
     (make-output-port
-     (object-name p)
+     name
      p
      p ; `write' just redirects to `p'
      ;; Here's the slow way to redirect: