Fix a small but nasty bug, and the related problem in stubs.

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))

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 '()])

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."))

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."))

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."))

collects/meta/web/stubs/shared.rkt

@@ -1,5 +0,0 @@
-#lang at-exp s-exp "../common.rkt"
-
-(provide page (all-from-out "../common.rkt"))
-
-(define+provide-context "stubs")