mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

updates

Browse Source
pull/9/head
Matthew Butterick 11 years ago
parent 7caab48bba
commit 1135abad7e
2 changed files with 43 additions and 23 deletions
Show Stats Download Patch File Download Diff File

17
debug.rkt
Unescape Escape View File

@ -17,6 +17,16 @@
; debug utilities
(define months (list "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
(define last-message-time #f)
(define (seconds-since-last-message)
(define now (current-seconds))
(define then last-message-time)
(set! last-message-time now)
(if then
(- now then)
"--"))
(define (message . items)
(define (zero-fill str count)
(set! str (~a str))
@ -28,16 +38,17 @@
(define date (current-date))
(define date-fields (map (λ(x) (zero-fill x 2))
(list
(date-day date)
(list-ref months (sub1 (date-month date)))
; (date-day date)
; (list-ref months (sub1 (date-month date)))
(if (<= (date-hour date) 12)
(date-hour date) ; am hours + noon hour
(modulo (date-hour date) 12)) ; pm hours after noon hour
(date-minute date)
(date-second date)
; (if (< (date-hour date) 12) "am" "pm")
(seconds-since-last-message)
)))
(apply format "[~a-~a ~a:~a:~a]" date-fields))
(apply format "[~a:~a:~a ~as]" date-fields))
(displayln (string-join `(,(make-date-string) ,@(map (λ(x)(if (string? x) x (~v x))) items))) (current-error-port)))

47
render.rkt
Unescape Escape View File

@ -7,6 +7,11 @@
(provide render render-with-session)
;; for shared use by eval & system
(define nowhere-port (open-output-nowhere))
;; mod-dates is a hash that takes lists of paths as keys,
;; and lists of modification times as values.
;; Reason: a templated page is a combination of two source files.
@ -105,6 +110,7 @@
(() (#:force boolean?) #:rest (listof pathish?) . ->* . void?)
(define (&render x)
(let ([path (->complete-path (->path x))])
; (message "Dispatching render for" (->string (file-name-from-path path)))
(cond
;; this will catch preprocessor files
[(needs-preproc? path) (render-with-preproc path #:force force)]
@ -116,7 +122,7 @@
(render-ptree-files ptree #:force force))]
[(equal? FALLBACK_TEMPLATE_NAME (->string (file-name-from-path path)))
(message "Render: using fallback template")]
[(file-exists? path) 'pass-through]
[(file-exists? path) (message "Serving static file" (->string (file-name-from-path path)))]
[else (error "Render couldn't find" (->string (file-name-from-path path)))])))
(for-each &render xs))
@ -135,7 +141,7 @@
(define/contract (up-to-date-message path)
(any/c . -> . void?)
(message "File is up to date:" (->string (file-name-from-path path))))
(message (->string (file-name-from-path path)) "is up to date, using cached copy"))
(define/contract (render-with-preproc x #:force [force #f])
@ -161,12 +167,12 @@
;; use single quotes to escape spaces in pathnames
(let ([command (format "~a '~a' > '~a'" RACKET_PATH source-path output-path)])
(rendering-message (format "~a from ~a"
(file-name-from-path output-path)
(file-name-from-path source-path)))
(file-name-from-path output-path)
(file-name-from-path source-path)))
(store-refresh-in-mod-dates source-path)
;; discard output using open-output-nowhere
(parameterize ([current-directory source-dir]
[current-output-port (open-output-nowhere)])
[current-output-port nowhere-port])
(system command))
(rendered-message output-path))
;; otherwise, skip file because there's no trigger for refresh
@ -241,10 +247,10 @@
;; path using default template name =
;; "-main" + extension from output path (e.g. foo.xml.p -> -main.xml)
(build-path source-dir (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path)))))))
;; if none of these work, make temporary template file
(let ([tp (build-path source-dir FALLBACK_TEMPLATE_NAME)])
(display-to-file #:exists 'replace fallback-template-data tp)
tp)))
;; if none of these work, make fallback template file
(let ([ft-path (build-path source-dir FALLBACK_TEMPLATE_NAME)])
(display-to-file #:exists 'replace fallback-template-data ft-path)
ft-path)))
;; refresh template (it might have its own preprocessor file)
(render template-path #:force force)
@ -252,8 +258,8 @@
;; calculate new path for generated file
(define output-path (->output-path source-path))
;; 2) render the source file with template, if needed.
;; render is expensive, so we avoid it when we can.
;; 2) Render the source file with template, if needed.
;; Render is expensive, so we avoid it when we can.
;; Four conditions where we render:
(if (or force ; a) it's explicitly demanded
(not (file-exists? output-path)) ; b) output file does not exist
@ -291,15 +297,18 @@
;; that represents the output of the operation.
(parameterize ([current-namespace (make-base-empty-namespace)]
[current-directory source-dir]
[current-output-port (open-output-nowhere)])
[current-output-port nowhere-port]
[current-error-port nowhere-port]) ; silent evaluation; exceptions still thrown
(namespace-require 'racket) ; use namespace-require for FIRST require, then eval after
;; for include-template (used below)
(eval '(require web-server/templates) (current-namespace))
;; for ptree navigation functions, and template commands
(eval '(require (planet mb/pollen/debug)(planet mb/pollen/ptree)(planet mb/pollen/template)) (current-namespace))
;; import source into eval space. This sets up main & metas
(eval `(require ,(path->string source-name)) (current-namespace))
(eval `(include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)) (current-namespace))))
(eval `(begin
;; for include-template (used below)
(require web-server/templates)
;; for ptree navigation functions, and template commands
(require (planet mb/pollen/debug) (planet mb/pollen/ptree) (planet mb/pollen/template))
;; import source into eval space. This sets up main & metas
(require ,(->string source-name))
(include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)))
(current-namespace))))
;; render files listed in a ptree file
(define/contract (render-ptree-files ptree #:force [force #f])

Write Preview
Loading…
Cancel
Save