From 054ce9d21cf9928153f42c372574694226ccc212 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Sun, 6 Jun 2010 05:40:16 -0400
Subject: [PATCH] Fix a small but nasty bug, and the related problem in stubs.

---
 collects/meta/web/common/layout.rkt | 14 ++++++++++----
 collects/meta/web/html/resource.rkt |  3 ++-
 collects/meta/web/stubs/blog.rkt    |  6 ++++--
 collects/meta/web/stubs/git.rkt     |  6 ++++--
 collects/meta/web/stubs/pre.rkt     |  8 +++++---
 collects/meta/web/stubs/shared.rkt  |  5 -----
 6 files changed, 25 insertions(+), 17 deletions(-)
 delete mode 100644 collects/meta/web/stubs/shared.rkt

diff --git a/collects/meta/web/common/layout.rkt b/collects/meta/web/common/layout.rkt
index 3c379dff8e..f92b13774d 100644
--- a/collects/meta/web/common/layout.rkt
+++ b/collects/meta/web/common/layout.rkt
@@ -156,14 +156,14 @@
 
 ;; `define+provide-context' should be used in each toplevel directory (= each
 ;; site) to have its own resources (and possibly other customizations).
-(provide define+provide-context)
-(define-syntax (define+provide-context stx)
+(provide define+provide-context define-context)
+(define-for-syntax (make-define+provide-context stx provide?)
   (syntax-case stx ()
     [(_ dir)
      (with-syntax ([page-id     (datum->syntax stx 'page)]
                    [plain-id    (datum->syntax stx 'plain)]
                    [copyfile-id (datum->syntax stx 'copyfile)])
-       #'(begin
+       #`(begin
            (define resources
              (make-resources (make-icon dir) (make-logo dir) (make-style dir)))
            (define-syntax-rule (page-id . xs)
@@ -172,4 +172,10 @@
              (plain #:dir dir . xs))
            (define (copyfile-id source [target #f] [referrer values])
              (copyfile-resource source target referrer #:dir dir))
-           (provide page-id plain-id copyfile-id)))]))
+           #,@(if provide?
+                #'((provide page-id plain-id copyfile-id))
+                '())))]))
+(define-syntax (define+provide-context stx)
+  (make-define+provide-context stx #t))
+(define-syntax (define-context stx)
+  (make-define+provide-context stx #f))
diff --git a/collects/meta/web/html/resource.rkt b/collects/meta/web/html/resource.rkt
index b9ef57f007..3655fc3d0f 100644
--- a/collects/meta/web/html/resource.rkt
+++ b/collects/meta/web/html/resource.rkt
@@ -63,7 +63,8 @@
              (let loop ([r (car root+url)] [p path])
                (if (null? r)
                  `(,(cdr root+url) ,@p ,file*)
-                 (and (pair? p) (loop (cdr r) (cdr p))))))
+                 (and (pair? p) (equal? (car p) (car r))
+                      (loop (cdr r) (cdr p))))))
            roots))
   (define result
     (let loop ([t tgtdir] [c curdir] [pfx '()])
diff --git a/collects/meta/web/stubs/blog.rkt b/collects/meta/web/stubs/blog.rkt
index 015251800b..95ec221026 100644
--- a/collects/meta/web/stubs/blog.rkt
+++ b/collects/meta/web/stubs/blog.rkt
@@ -1,7 +1,9 @@
-#lang at-exp s-exp "shared.rkt"
+#lang at-exp s-exp "../common.rkt"
+
+(define-context "stubs/blog")
 
 (provide blog)
 (define blog
-  (page #:file "blog/"
+  (page #:file ""
         ;; #:part-of community  <-- TODO: is doing this a good idea
     "This is a stub page to get the header for the blog."))
diff --git a/collects/meta/web/stubs/git.rkt b/collects/meta/web/stubs/git.rkt
index 4919664249..7b8a31fdd4 100644
--- a/collects/meta/web/stubs/git.rkt
+++ b/collects/meta/web/stubs/git.rkt
@@ -1,6 +1,8 @@
-#lang at-exp s-exp "shared.rkt"
+#lang at-exp s-exp "../common.rkt"
+
+(define-context "stubs/git")
 
 (provide git)
 (define git
-  (page #:title "Development Repository" #:file "git/"
+  (page #:title "Development Repository" #:file ""
     "This is a stub page to get the header for the gitweb server."))
diff --git a/collects/meta/web/stubs/pre.rkt b/collects/meta/web/stubs/pre.rkt
index 508631be7a..e9f0df7b3f 100644
--- a/collects/meta/web/stubs/pre.rkt
+++ b/collects/meta/web/stubs/pre.rkt
@@ -1,11 +1,13 @@
-#lang at-exp s-exp "shared.rkt"
+#lang at-exp s-exp "../common.rkt"
+
+(define-context "stubs/pre")
 
 (provide pre-root)
 (define pre-root
-  (page #:file "pre/" #:title "Prebuilt materials"
+  (page #:file "" #:title "Prebuilt materials"
     "This is a stub page to get the header for the nightly builds root."))
 
 (provide pre-installers)
 (define pre-installers
-  (page #:file "pre/installers/" #:title "Nightly build installers"
+  (page #:file "installers/" #:title "Nightly build installers"
     "This is a stub page to get the header for the nightly installers."))
diff --git a/collects/meta/web/stubs/shared.rkt b/collects/meta/web/stubs/shared.rkt
deleted file mode 100644
index 6025425597..0000000000
--- a/collects/meta/web/stubs/shared.rkt
+++ /dev/null
@@ -1,5 +0,0 @@
-#lang at-exp s-exp "../common.rkt"
-
-(provide page (all-from-out "../common.rkt"))
-
-(define+provide-context "stubs")