diff --git a/collects/scribble/extract.ss b/collects/scribble/extract.ss index fa141146..1d51a912 100644 --- a/collects/scribble/extract.ss +++ b/collects/scribble/extract.ss @@ -4,6 +4,7 @@ scribble/decode scribble/srcdoc (for-syntax scheme/base + scheme/path syntax/path-spec)) (provide include-extracted) @@ -28,7 +29,9 @@ (raise-syntax-error #f "expected a literal regular expression as the second argument" stx #'regexp-s)) (let ([s-exp (parameterize ([current-namespace (make-base-namespace)] - [read-accept-reader #t]) + [read-accept-reader #t] + [current-load-relative-directory + (path-only path)]) (expand (with-input-from-file path (lambda () diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index c644eb38..4c00bc3f 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -50,7 +50,7 @@ (define-syntax (schememod stx) (syntax-case stx () - [(_ lang rest ...) + [(_ #:file filename lang rest ...) (with-syntax ([modtag (datum->syntax #'here `(unsyntax (make-element @@ -60,8 +60,18 @@ (as-modname-link ',#'lang (to-element ',#'lang))))) - #'lang)]) - #'(schemeblock modtag rest ...))])) + #'lang)] + [(file ...) + (if (syntax-e #'filename) + (list + (datum->syntax + #'filename + `(code:comment (unsyntax (t "In \"" ,#'filename "\":"))) + #'filename)) + null)]) + (syntax/loc stx (schemeblock file ... modtag rest ...)))] + [(_ lang rest ...) + (syntax/loc stx (schememod #:file #f lang rest ...))])) (define (to-element/result s) (make-element "schemeresult" (list (to-element/no-color s))))