pull/9/head
Matthew Butterick 10 years ago
parent fbed39423f
commit 164bda9c2e

@ -4,20 +4,20 @@
(require (for-syntax racket/rerequire pollen/tools pollen/world)) (require (for-syntax racket/rerequire pollen/tools pollen/world))
(require pollen/tools pollen/world) (require pollen/tools pollen/world)
(provide here-path get-here-path require-extras require-and-provide-extras bound/c (provide (except-out (all-defined-out) top~)
(rename-out (top~ #%top))) (rename-out (top~ #%top)))
(module+ test (require rackunit)) (module+ test (require rackunit))
(define-syntax-rule (top~ . id) (define-syntax-rule (top~ . id)
(λ x `(id ,@x))) (λ x `(id ,@x)))
(define-syntax (bound/c stx) (define-syntax (bound/c stx)
(syntax-case stx () (syntax-case stx ()
[(_ x) [(_ x)
(if (identifier-binding #'x ) (if (identifier-binding #'x )
#'x #'x
#'(#%top . x))])) #'(#%top . x))]))
(define-for-syntax (put-file-in-require-form file) (define-for-syntax (put-file-in-require-form file)
`(file ,(->string file))) `(file ,(->string file)))
@ -25,21 +25,21 @@
(define-syntax (require-and-provide-extras stx) (define-syntax (require-and-provide-extras stx)
(define project-require-files (get-project-require-files)) (define project-require-files (get-project-require-files))
(if project-require-files (if project-require-files
(let ([files-in-require-form (map put-file-in-require-form project-require-files)]) (let ([files-in-require-form (map put-file-in-require-form project-require-files)])
(datum->syntax stx `(begin (datum->syntax stx `(begin
(require ,@files-in-require-form) (require ,@files-in-require-form)
(provide (all-from-out ,@files-in-require-form))))) (provide (all-from-out ,@files-in-require-form)))))
; if no files to import, do nothing ; if no files to import, do nothing
#'(begin))) #'(begin)))
(define-syntax (require-extras stx) (define-syntax (require-extras stx)
(define project-require-files (get-project-require-files)) (define project-require-files (get-project-require-files))
(if project-require-files (if project-require-files
(let ([files-in-require-form (map put-file-in-require-form project-require-files)]) (let ([files-in-require-form (map put-file-in-require-form project-require-files)])
(datum->syntax stx `(begin (datum->syntax stx `(begin
(require ,@files-in-require-form)))) (require ,@files-in-require-form))))
; if no files to import, do nothing ; if no files to import, do nothing
#'(begin))) #'(begin)))
;; here = path of this file, relative to current directory. ;; here = path of this file, relative to current directory.
@ -55,13 +55,13 @@
;; Therefore, best to use let. ;; Therefore, best to use let.
(let* ([ccr (current-contract-region)] ; trick for getting current module name (let* ([ccr (current-contract-region)] ; trick for getting current module name
[hp (cond [hp (cond
;; if contract-region is called from within submodule, ;; if contract-region is called from within submodule,
;; you get a list ;; you get a list
;; in which case, just grab the path from the front ;; in which case, just grab the path from the front
[(list? ccr) (car ccr)] [(list? ccr) (car ccr)]
;; file isn't yet saved in drracket ;; file isn't yet saved in drracket
[(equal? 'pollen-lang-module ccr) 'nowhere] [(equal? 'pollen-lang-module ccr) 'nowhere]
[else ccr])]) [else ccr])])
;; pass complete path back as here value (as string) ;; pass complete path back as here value (as string)
;; Why not relative to current-directory? ;; Why not relative to current-directory?
;; Because current-directory can't be parameterized ;; Because current-directory can't be parameterized

@ -34,7 +34,7 @@
(provide (all-from-out ; pollen file should bring its requires (provide (all-from-out ; pollen file should bring its requires
pollen/tools))) pollen/tools)))
(require 'pollen-inner) ; provides doc, among other things (require 'pollen-inner) ; provides doc & #%top, among other things
(define here ((bound/c path->pnode) inner-here-path)) (define here ((bound/c path->pnode) inner-here-path))
@ -68,7 +68,7 @@
;; Because if it's overridden to something other than *.ptree, ;; Because if it's overridden to something other than *.ptree,
;; ptree processing will fail. ;; ptree processing will fail.
;; This defeats rule that ptree file suffix triggers ptree decoding. ;; This defeats rule that ptree file suffix triggers ptree decoding.
(define here-is-ptree? (ptree-source? (->path inner-here-path))) (define here-is-ptree? ((bound/c ptree-source?) (->path inner-here-path)))
(define main (apply (if here-is-ptree? (define main (apply (if here-is-ptree?
;; ptree source files will go this way, ;; ptree source files will go this way,

@ -350,7 +350,7 @@
;; for include-template (used below) ;; for include-template (used below)
(require web-server/templates) (require web-server/templates)
;; for ptree navigation functions, and template commands ;; for ptree navigation functions, and template commands
(require pollen/debug pollen/ptree pollen/template) (require pollen/debug pollen/ptree pollen/template pollen/main-helper)
;; import source into eval space. This sets up main & metas ;; import source into eval space. This sets up main & metas
(require ,(->string source-name)) (require ,(->string source-name))
(parameterize ([current-ptree (make-project-ptree ,PROJECT_ROOT)] (parameterize ([current-ptree (make-project-ptree ,PROJECT_ROOT)]

Loading…
Cancel
Save