improve current-server-extras-path

pull/29/head
Matthew Butterick 10 years ago
parent a22931f359
commit 1d31988f2b

@ -1,6 +1,6 @@
#lang web-server/base #lang web-server/base
(require racket/list racket/contract (require racket/list
web-server/servlet-env web-server/servlet-env
web-server/dispatch) web-server/dispatch)
(require "server-routes.rkt" (require "server-routes.rkt"
@ -26,12 +26,8 @@
(define server-name (format "http://localhost:~a" (world:current-server-port))) (define server-name (format "http://localhost:~a" (world:current-server-port)))
(message (format "Project server is ~a" server-name) "(Ctrl-C to exit)") (message (format "Project server is ~a" server-name) "(Ctrl-C to exit)")
(message (format "Project dashboard is ~a/~a" server-name world:default-pagetree)) (message (format "Project dashboard is ~a/~a" server-name world:default-pagetree))
(message "Ready to rock") (message "Ready to rock")
(define module-root (apply build-path (drop-right (explode-path (current-contract-region)) 1)))
(world:current-server-extras-path (build-path module-root world:server-extras-dir))
(parameterize ([error-print-width 1000] (parameterize ([error-print-width 1000]
[current-cache (make-cache)]) [current-cache (make-cache)])
(serve/servlet pollen-servlet (serve/servlet pollen-servlet

@ -1,4 +1,5 @@
#lang racket/base #lang racket/base
(require racket/runtime-path)
(provide (prefix-out world: (all-defined-out))) (provide (prefix-out world: (all-defined-out)))
@ -53,8 +54,8 @@
(define dashboard-css "poldash.css") (define dashboard-css "poldash.css")
(define server-extras-dir "server-extras") (define-runtime-path server-extras-dir "server-extras")
(define current-server-extras-path (make-parameter #f)) (define current-server-extras-path (make-parameter server-extras-dir))
(define check-directory-requires-in-render? (make-parameter #t)) (define check-directory-requires-in-render? (make-parameter #t))

Loading…
Cancel
Save