From 1cce6c1f882e33873a42055e4fac312f512dafb4 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Wed, 16 Jun 2010 01:43:34 -0400
Subject: [PATCH] Factor our the common path computation.

---
 collects/meta/web/common/layout.rkt | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

diff --git a/collects/meta/web/common/layout.rkt b/collects/meta/web/common/layout.rkt
index 4e121b3bcf..7b1c2ee7cd 100644
--- a/collects/meta/web/common/layout.rkt
+++ b/collects/meta/web/common/layout.rkt
@@ -19,12 +19,16 @@
                        [body #`(lambda () (text #,@xs))])
            #'(layouter id ... x ... body))])))
 
-(define (id->file who id sfx)
-  (let ([f (and id (symbol->string (force id)))])
-    (cond [(and f (regexp-match #rx"[.]" f)) f]
-          [(and f sfx) (string-append f (regexp-replace #rx"^[.]?" sfx "."))]
-          [else (error who "missing `#:file', or `#:id'~a"
-                       (if sfx "" " and `#:suffix'"))])))
+(define (get-path who id file sfx dir)
+  (define file*
+    (or file
+        (let ([f (and id (symbol->string (force id)))])
+          (cond [(and f (regexp-match #rx"[.]" f)) f]
+                [(and f sfx)
+                 (string-append f (regexp-replace #rx"^[.]?" sfx "."))]
+                [else (error who "missing `#:file', or `#:id'~a"
+                             (if sfx "" " and `#:suffix'"))]))))
+  (if dir (web-path dir file*) file*))
 
 ;; The following are not intended for direct use, see
 ;; `define+provide-context' below (it could be used with #f for the
@@ -34,23 +38,21 @@
 ;; for plain text files
 (define-syntax (plain stx)
   (syntax-case stx () [(_ . xs) (process-contents 'plain #'plain* stx #'xs)]))
-(define (plain* #:id [id #f] #:suffix [suffix #f] #:dir [dir #f]
-                #:file [file (id->file 'plain id suffix)]
+(define (plain* #:id [id #f] #:suffix [suffix #f]
+                #:dir [dir #f] #:file [file #f]
                 #:referrer
                 [referrer (lambda (url)
                             (error 'plain "no referrer for ~e" file))]
                 #:newline [newline? #t]
                 content)
-  (resource (if dir (web-path dir file) file)
+  (resource (get-path 'plain id file suffix dir)
             (file-writer output (list content (and newline? "\n")))
             referrer))
 
 ;; page layout function
 (define-syntax (page stx)
   (syntax-case stx () [(_ . xs) (process-contents 'page #'page* stx #'xs)]))
-(define (page* #:id [id #f]
-               #:dir [dir #f]
-               #:file [file (id->file 'page id "html")]
+(define (page* #:id [id #f] #:dir [dir #f] #:file [file #f]
                #:title [label (if id
                                 (let* ([id (->string (force id))]
                                        [id (regexp-replace #rx"^.*/" id "")]
@@ -79,7 +81,7 @@
              @(if body-attrs
                 (apply body `(,@body-attrs ,content))
                 (body content))}))
-  (define this (resource (if dir (web-path dir file) file)
+  (define this (resource (get-path 'plain id file "html" dir)
                          (file-writer output-xml page)
                          referrer))
   this)