plt-web: add make-indexes

pkgs/plt-web-pkgs/plt-web-doc/plt-web.scrbl

@@ -196,6 +196,21 @@ Like @racket[page*], but for a resource that is a plain file.}
 Registers a resource that is either a copy of a file or a symbolic link,
 returning a value that can be used to reference the resource.}
 
+
+@defproc[(make-indexes [s site?]
+                       [dir (or/c 'same relative-path?)]
+                       [#:depth depth (or/c #f exact-nonnegative-integer?)])
+         void?]{
+
+Registers an @filepath{index.html} file for every directory within
+@racket[dir] (relative to the current directory) that does not have an
+@filepath{index.html} file already. If @racket[depth] is not @racket[#f],
+then subdirectories are explored at most @racket[depth] layers deep.
+
+The generated index files are registered for the site @racket[s] at
+destinations that correspond to treating the current directory as the
+site root.}
+
 @; ----------------------------------------
 
 @section{Generating Site Content}

pkgs/plt-web-pkgs/plt-web-lib/indexes.rkt

@@ -0,0 +1,34 @@
+#lang at-exp racket/base
+(require scribble/html
+         racket/format
+         "layout.rkt")
+
+(provide make-indexes)
+
+(define (build site p)
+  (let ([dir (current-directory)])
+    (unless (file-exists? (build-path dir p "index.html"))
+      (page #:site site
+            #:file (if (eq? p 'same)
+                       "index.html"
+                       (path->string (build-path p "index.html")))
+            #:title "Index"
+            @table{@(for/list ([i (in-list
+                                   (directory-list (build-path dir p)))])
+                      @tr{@td{@a[href: (path->string i)]{@(path->string i)}}
+                          @td{@(let ([i (build-path dir p i)])
+                                 (if (file-exists? i)
+                                     (let ([s (file-size i)])
+                                       (~a (ceiling (/ s 1024)) "k"))
+                                     ""))}})}))))
+
+(define (make-indexes site [dir 'same] 
+                      #:depth [depth #f])
+  (build site dir)
+  (when (or (not depth) (positive? depth))
+    (for ([d (in-list (directory-list (if (eq? dir 'same)
+                                          (current-directory)
+                                          dir)))])
+      (define p (if (eq? dir 'same) d (build-path dir d)))
+      (when (directory-exists? p)
+        (make-indexes site p #:depth (and depth (sub1 depth)))))))

pkgs/plt-web-pkgs/plt-web-lib/main.rkt

@@ -1,9 +1,11 @@
 #lang racket/base
 
 (require (except-in scribble/html/lang #%module-begin)
-         "layout.rkt" "extras.rkt" "links.rkt" "utils.rkt")
+         "layout.rkt" "extras.rkt" "links.rkt" "utils.rkt"
+         "indexes.rkt")
 (provide (all-from-out scribble/html/lang
-                       "layout.rkt" "extras.rkt" "links.rkt")
+                       "layout.rkt" "extras.rkt" "links.rkt"
+                       "indexes.rkt")
          basename web-path url-of ; from "utils.rkt"
          (rename-out [module-begin #%module-begin]))