From 0c95475f4ffbc343291e5529a6f4b32a91159ef1 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 15 May 2012 17:36:01 -0600
Subject: [PATCH] fixes for `scribble/srcdoc'

Use the new `relative-in' form to make imports
resolve correctly when they are shifted among modules.
---
 collects/drracket/tool-lib.rkt |  2 +-
 collects/scribble/extract.rkt  |  3 ++-
 collects/scribble/srcdoc.rkt   | 20 ++++++++++++++++++--
 3 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/collects/drracket/tool-lib.rkt b/collects/drracket/tool-lib.rkt
index 2733f309e5..58f108a36e 100644
--- a/collects/drracket/tool-lib.rkt
+++ b/collects/drracket/tool-lib.rkt
@@ -76,7 +76,7 @@ all of the names in the tools library, for use defining keybindings
                                   [_
                                    (raise-syntax-error 'provide/dr/doc "unknown thing" case)])])
                    (with-syntax ([mid (munge-id #'id)])
-                     #'(thing-doc mid ctc ("This is provided for backwards compatibility; new code should use " (racket id) " instead.")))))
+                     #`(thing-doc mid ctc (@undefined-const "This is provided for backwards compatibility; new code should use " (racket id) " instead.")))))
                (syntax->list #'(case ...)))])])
     (syntax-case stx ()
       [(_  rst ...)
diff --git a/collects/scribble/extract.rkt b/collects/scribble/extract.rkt
index 0c165ee8de..11661a93a9 100644
--- a/collects/scribble/extract.rkt
+++ b/collects/scribble/extract.rkt
@@ -22,7 +22,8 @@
                    #'(xwrap (... ...) id))
                  ;; delayed:
                  (with-syntax ([(_ xwrap (... ...)) stx]
-                               [(reqs ((id d) (... ...))) (get-docs)])
+                               [(reqs ((id d) (... ...))) (syntax-local-introduce
+                                                           (datum->syntax #f (get-docs)))])
                    #`(begin
                        (require . reqs)
                        (xwrap (... ...) (list (cons 'id d) (... ...)))))))
diff --git a/collects/scribble/srcdoc.rkt b/collects/scribble/srcdoc.rkt
index e65c90f980..77b0c5ce1e 100644
--- a/collects/scribble/srcdoc.rkt
+++ b/collects/scribble/srcdoc.rkt
@@ -2,7 +2,8 @@
 (require racket/contract/base
          (for-syntax racket/base
                      racket/require-transform
-                     racket/provide-transform))
+                     racket/provide-transform
+                     syntax/private/modcollapse-noctc))
 
 (provide for-doc require/doc
          provide/doc ; not needed anymore
@@ -21,9 +22,24 @@
  (define (add-requires!/decl specs)
    (unless delayed?
      (syntax-local-lift-module-end-declaration
-      #`(begin-for-syntax (add-requires! (quote-syntax #,specs)))))
+      #`(begin-for-syntax (add-relative-requires! (#%variable-reference)
+                                                  (quote-syntax #,specs)))))
    (add-requires! (syntax-local-introduce specs)))
 
+ (define (add-relative-requires! varref specs)
+   (define mpi (variable-reference->module-path-index varref))
+   (define-values (name base) (module-path-index-split mpi))
+   (if name
+       (add-requires!
+        (with-syntax ([(spec ...) specs]
+                      [rel-to (collapse-module-path-index 
+                               mpi
+                               (build-path (or (current-load-relative-directory)
+                                               (current-directory))
+                                           "here.rkt"))])
+          #'((relative-in rel-to spec) ...)))
+       (add-requires! specs)))
+
  (define (add-requires! specs)
    (set! requires (cons specs requires)))