From 06f67b30f34c94cdd6cd617e78e60391d14f5c45 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Wed, 27 Jun 2012 06:10:31 -0400
Subject: [PATCH] Improve resource-files code.

Makes it easy to add more files without more bindings.
---
 collects/meta/web/common/layout.rkt    | 45 +++++++++++++-------------
 collects/meta/web/common/resources.rkt | 21 ++++++------
 2 files changed, 32 insertions(+), 34 deletions(-)

diff --git a/collects/meta/web/common/layout.rkt b/collects/meta/web/common/layout.rkt
index f1854e9801..c0339134c2 100644
--- a/collects/meta/web/common/layout.rkt
+++ b/collects/meta/web/common/layout.rkt
@@ -178,30 +178,33 @@
 
 (define (html-head-maker style favicon)
   (define headers
-    @list{@meta[name: "generator" content: "Racket"]
-          @meta[http-equiv: "Content-Type" content: "text/html; charset=utf-8"]
-          @favicon
-          @style})
+    @list{
+      @meta[name: "generator" content: "Racket"]
+      @meta[http-equiv: "Content-Type" content: "text/html; charset=utf-8"]
+      @favicon
+      @link[rel: "stylesheet" type: "text/css" href: style title: "default"]})
   (λ (title* more-headers)
     (head "\n" (title title*)
           "\n" headers
           (and more-headers (list "\n" more-headers))
           "\n")))
 
-(define (make-resources icon logo style)
-  (let* ([favicon     (html-favicon-maker icon)]
-         [make-head   (html-head-maker style favicon)]
-         [make-navbar (navbar-maker logo)])
-    (λ (what . more)
-      (apply (case what
-               [(head)   make-head]
-               [(navbar) make-navbar]
-               [(favicon-headers) favicon]
-               [(icon-path)  (λ () (url-of icon))]
-               [(logo-path)  (λ () (url-of logo))]
-               [(style-path) (λ () (url-of style))]
-               [else (error 'resources "internal error")])
-             more))))
+(define (make-resources files)
+  (define (getfile what) (cadr (assq what files)))
+  (define favicon     (html-favicon-maker (getfile 'icon)))
+  (define make-head   (html-head-maker (getfile 'style) favicon))
+  (define make-navbar (navbar-maker (getfile 'logo)))
+  (λ (what . more)
+    (apply (case what
+             [(head)   make-head]
+             [(navbar) make-navbar]
+             [(favicon-headers) favicon]
+             [(icon-path logo-path style-path)
+              (λ () (let* ([x (symbol->string what)]
+                           [x (regexp-replace #rx"-path$" x "")])
+                      (url-of (getfile (string->symbol x)))))]
+             [else (error 'resources "internal error")])
+           more)))
 
 ;; `define+provide-context' should be used in each toplevel directory (= each
 ;; site) to have its own resources (and possibly other customizations).
@@ -214,10 +217,8 @@
                   [copyfile-id  (datum->syntax stx 'copyfile)]
                   [symlink-id   (datum->syntax stx 'symlink)]
                   [resources-id (datum->syntax stx 'the-resources)])
-      (with-syntax ([resources (or resources
-                                   #'(make-resources (make-icon dir)
-                                                     (make-logo dir)
-                                                     (make-style dir)))]
+      (with-syntax ([resources (or resources #'(make-resources
+                                                (make-resource-files dir)))]
                     [provides (if provide?
                                 #'(provide page-id plain-id copyfile-id
                                            symlink-id resources-id)
diff --git a/collects/meta/web/common/resources.rkt b/collects/meta/web/common/resources.rkt
index 4371b1b621..5af468e8f2 100644
--- a/collects/meta/web/common/resources.rkt
+++ b/collects/meta/web/common/resources.rkt
@@ -10,20 +10,17 @@
 
 (require "utils.rkt")
 
-(provide make-logo make-icon make-style
+(provide make-resource-files
          navbar-style page-sizes font-family) ; needed for the blog template
 
-(define ((make-file-copier file) dir)
-  (copyfile-resource (in-here file) (web-path dir file)))
-
-(define make-logo (make-file-copier "logo.png"))
-(define make-icon (make-file-copier "plticon.ico"))
-
-(define (make-style dir)
-  (resource/referrer (web-path dir "plt.css")
-                     (file-writer output (list racket-style "\n"))
-                     (λ (url) (link rel: "stylesheet" type: "text/css"
-                                    href: url title: "default"))))
+(define (make-resource-files dir)
+  (define (copyfile file)
+    (copyfile-resource (in-here file) (web-path dir file)))
+  (define (writefile file contents)
+    (resource (web-path dir file) (file-writer output (list contents "\n"))))
+  `([logo  ,(copyfile  "logo.png")]
+    [icon  ,(copyfile  "plticon.ico")]
+    [style ,(writefile "plt.css" racket-style)]))
 
 (define page-sizes
   @list{