add support for scrbl files

file-tools.rkt

@@ -78,7 +78,7 @@
 ;; get file extension as a string, or return #f 
 ;; (consistent with filename-extension behavior)
 (define+provide/contract (get-ext x)
-  (coerce/path? . -> . (or/c string? #f))
+  (coerce/path? . -> . (or/c #f string?))
   (let ([fe-result (filename-extension x)])
     (and fe-result (bytes->string/utf-8 fe-result))))
 
@@ -113,13 +113,15 @@
 
 (define-syntax (make-source-utility-functions stx)
   (syntax-case stx ()
-    [(_ stem file-ext)
-     (with-syntax ([stem-source? (format-id stx "~a-source?" #'stem)]
+    [(_ stem)
+     (let ([stem-datum (syntax->datum #'stem)])
+       (with-syntax ([file-ext (format-id stx "world:~a-source-ext" #'stem)]
+                     [stem-source? (format-id stx "~a-source?" #'stem)]
                      [has-stem-source? (format-id stx "has-~a-source?" #'stem)]
                      [has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)]
                      [->stem-source-path (format-id stx "->~a-source-path" #'stem)]
                      [->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)])
-       #'(begin
+         #`(begin
              ;; does file have particular extension
              (define+provide/contract (stem-source? x)
                (any/c . -> . boolean?)
@@ -138,28 +140,34 @@
              ;; add the file extension if it's not there
              (define+provide/contract (->stem-source-path x)
                (pathish? . -> . path?)
-             (->path (if (stem-source? x) x (add-ext x file-ext))))
+               (->path (if (stem-source? x) 
+                           x 
+                           #,(if (equal? stem-datum 'scribble)
+                                 #'(add-ext (remove-all-ext x) file-ext) ; different logic for scribble sources
+                                 #'(add-ext x file-ext)))))
              
              ;; coerce either a source or output file to both
              (define+provide/contract (->stem-source+output-paths path)
                (pathish? . -> . (values path? path?))
                (values (->complete-path (->stem-source-path path))
-                     (->complete-path (->output-path path))))))]))
-
+                       (->complete-path (->output-path path)))))))]))
 
-(make-source-utility-functions preproc world:preproc-source-ext)
-(make-source-utility-functions null world:null-source-ext)
-(make-source-utility-functions ptree world:ptree-source-ext)
-(make-source-utility-functions markup world:markup-source-ext)
-(make-source-utility-functions template world:template-source-ext)
 
+(make-source-utility-functions preproc)
+(make-source-utility-functions null)
+(make-source-utility-functions ptree)
+(make-source-utility-functions markup)
+(make-source-utility-functions template)
+(make-source-utility-functions scribble)
 
 
+;; todo: move this into source-specific definitions
 (define+provide/contract (->output-path x)
   (coerce/path? . -> . coerce/path?)
-  (if (or (markup-source? x) (preproc-source? x) (null-source? x))
-      (remove-ext x)
-      x))
+  (cond
+    [(or (markup-source? x) (preproc-source? x) (null-source? x)) (remove-ext x)]
+    [(scribble-source? x) (add-ext (remove-ext x) 'html)]
+    [else x]))
 
 
 (define+provide/contract (project-files-with-ext ext)

render.rkt

@@ -54,7 +54,7 @@
   (let ([so-path (->complete-path pathish)])  ; so-path = source or output path (could be either) 
     (cond
       [(ormap (λ(test) (and (test so-path) (render-to-file-if-needed so-path #:force force)))
-              (list has/is-null-source? has/is-preproc-source? has/is-markup-source?))]
+              (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source?))]
       [(ptree-source? so-path) (let ([ptree (cached-require so-path world:main-pollen-export)])
                                  (for-each (λ(pnode) (render-for-dev-server pnode #:force force)) (ptree->list ptree)))]))
   (void))
@@ -64,8 +64,8 @@
   (complete-path? . -> . (values complete-path? complete-path?))
   ;; file-proc returns two values, but ormap only wants one
   (define file-proc (ormap (λ(test file-proc) (and (test source-or-output-path) file-proc))
-                           (list has/is-null-source? has/is-preproc-source? has/is-markup-source?)
-                           (list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths)))
+                           (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source?)
+                           (list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths ->scribble-source+output-paths)))
   (file-proc source-or-output-path))
 
 
@@ -107,8 +107,8 @@
   (define render-proc 
     (cond
       [(ormap (λ(test render-proc) (and (test source-path) render-proc))
-              (list has/is-null-source? has/is-preproc-source? has/is-markup-source?)
-              (list render-null-source render-preproc-source render-markup-source))]
+              (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source?)
+              (list render-null-source render-preproc-source render-markup-source render-scribble-source))]
       [else (error (format "render: no rendering function found for ~a" source-path))]))
   
   (message (format "render: ~a" (file-name-from-path source-path)))
@@ -123,6 +123,23 @@
   (file->bytes source-path))
 
 
+(define (render-through-scribble-eval expr-to-eval)
+  (parameterize ([current-namespace (make-base-namespace)]
+                 [current-output-port (current-error-port)])
+    (eval expr-to-eval (current-namespace))))
+
+
+(define/contract (render-scribble-source source-path)
+  (complete-path? . -> . bytes?)
+  (match-define-values (source-dir _ _) (split-path source-path))
+  (time (parameterize ([current-directory (->complete-path source-dir)])
+          (render-through-scribble-eval `(begin 
+                                           (require scribble/render)
+                                           (require (file ,(->string source-path)))
+                                           (render (list doc) '(,source-path))))))
+  (file->bytes (->output-path source-path)))
+
+
 (define/contract (render-preproc-source source-path)
   (complete-path? . -> . bytes?)
   (match-define-values (source-dir _ _) (split-path source-path))
@@ -154,7 +171,7 @@
 
 (define/contract (templated-source? path)
   (complete-path? . -> . boolean?)
-  (not (or (null-source? path) (preproc-source? path))))
+  (and (markup-source? path)))
 
 
 (define/contract (get-template-for source-path)

server-routes.rkt

@@ -163,13 +163,15 @@
     (define possible-sources 
       (if (directory-exists? fn)
           empty ;; folders don't have source files
-          (filter file-in-dir? (list (->preproc-source-path filename) (->markup-source-path filename) (->null-source-path filename)))))
+          (filter file-in-dir? (list (->preproc-source-path filename) (->markup-source-path filename) (->null-source-path filename) (->scribble-source-path filename)))))
     (define source (and (not (empty? possible-sources)) (->string (car possible-sources))))
     `(tr ,@(map make-link-cell 
                 (append (list                          
                          (cond ; main cell
                            [(directory-exists? (build-path dir filename)) ; links subdir to its dashboard
                             (cons (format "~a/~a" filename world:dashboard-name) (format "~a/" filename))]
+                           [(and source (equal? (get-ext source) "scrbl")) 
+                            (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) " (from " ,source ")")))]
                            [source (cons #f `(a ((href ,filename)) ,filename (span ((class "file-ext")) "." ,(get-ext source))))]
                            [else   (cons filename filename)])
                          

world.rkt

@@ -10,6 +10,8 @@
 (define null-source-ext 'p)
 (define ptree-source-ext 'ptree)
 (define template-source-ext 'pt)
+(define scribble-source-ext 'scrbl)
+
 
 (define reader-mode-auto 'auto)
 (define reader-mode-preproc 'pre)