plt-web: improve index-page support

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

@@ -200,14 +200,14 @@ 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?) #f]
                        [#:use-dir? use-dir? ((or/c 'same relative-path?) . -> . any/c) (lambda (dir) #t)])
          void?]{
 
-Registers an @filepath{index.html} file for every directory within
+Uses @racket[index-site] and @racket[index-page] to register 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.
@@ -218,6 +218,24 @@ The generated index files are registered for the site @racket[s] at
 destinations that correspond to treating the current directory as the
 site root.}
 
+@deftogether[(
+@defproc[(index-site? [v any/c]) boolean?]
+@defproc[(index-site [site site?]) index-site?]
+@defproc[(index-page [isite index-site?]
+                     [path (or/c 'same relative-path?)]
+                     [content (listof (cons/c path-string? (or/c exact-integer? 'dir)))])
+         outputable/c]
+)]{
+
+The @racket[index-page] function registers an individual
+@filepath{index.html} file for the given index site, where an index
+site is created once for a given site (to register support
+resources, such as icons). The @filepath{index.html} file is
+generated for the subdirectory indicated by @racket[path]. The index
+file lists the content specified by @racket[content], where
+an integer corresponds to a file size and @racket['dir] indicates
+a directory.}
+
 @; ----------------------------------------
 
 @section{Generating Site Content}

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

@@ -5,42 +5,63 @@
          "layout.rkt"
          "style.rkt")
 
-(provide make-indexes)
+(provide make-indexes
+         (rename-out [mk-index-site index-site])
+         index-site?
+         index-page)
 
 (define-runtime-path file-png "resources/file.png")
 (define-runtime-path folder-png "resources/folder.png")
 
-(define (build site p file-icon folder-icon)
-  (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"
-            @columns[10 #:row? #t]{
-              @table{@(for/list ([i (in-list
-                                     (directory-list (build-path dir p)))])
-                        @tr{@td{@a[href: (path->string i)]{@;
-                                 @img[src: (if (file-exists? (build-path dir p i))
-                                              file-icon
-                                              folder-icon)
+(struct index-site (site file-icon folder-icon))
+
+(define (index-page is dir content)
+  (page #:site (index-site-site is)
+        #:file (if (eq? dir 'same)
+                   "index.html"
+                   (path->string (build-path dir "index.html")))
+        #:title "Index"
+        @columns[10 #:row? #t]{
+              @table{@(for/list ([p+k (in-list content)])
+                        (define p (let ([p (car p+k)])
+                                    (if (path? p)
+                                        (path->string p)
+                                        p)))
+                        (define k (cdr p+k))
+                        @tr{@td{@a[href: p]{@;
+                                 @img[src: (if (number? k)
+                                              (index-site-file-icon is)
+                                              (index-site-folder-icon is))
                                      width: "16" height: "16"] @;
                                  @nbsp @;
-                                 @(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"))
-                                       ""))}})}}))))
+                                 @p}}
+                            @td{@(if (number? k)
+                                     (~a (ceiling (/ k 1024)) "k")
+                                     "")}})}}))
+
+(define mk-index-site
+  (let ([index-site
+         (lambda (site)
+           (define file-icon (copyfile #:site site file-png))
+           (define folder-icon (copyfile #:site site folder-png))
+           (index-site site file-icon folder-icon))])
+    index-site))
+
+(define (build is root-dir p)
+  (unless (file-exists? (build-path root-dir p "index.html"))
+    (index-page is p
+                (for/list ([i (in-list (directory-list (build-path root-dir p)))])
+                  (define f (build-path root-dir p i))
+                  (if (file-exists? f)
+                      (cons i (file-size f))
+                      (cons i 'dir))))))
 
 (define (make-indexes site [dir 'same] 
                       #:depth [depth #f]
                       #:use-dir? [use-dir? (lambda (p) #t)])
-  (define file-icon (copyfile #:site site file-png))
-  (define folder-icon (copyfile #:site site folder-png))
+  (define is (mk-index-site site))
   (let loop ([dir dir] [depth depth])
-    (build site dir file-icon folder-icon)
+    (build is (current-directory) dir)
     (when (and (or (not depth) (positive? depth))
                (use-dir? dir))
       (for ([d (in-list (directory-list (if (eq? dir 'same)

pkgs/plt-web-pkgs/plt-web-lib/resources/file-icons.rkt

@@ -14,6 +14,8 @@
 
   (define I 3)
 
+  (send dc set-smoothing 'smoothed)
+
   (send dc set-pen "black" 2 'solid)
   (send dc set-brush (make-color 200 200 200) 'solid)
   (send dc draw-polygon (list
@@ -41,7 +43,9 @@
   (define H 12)
   (define T (/ D 2))
 
-   (send dc set-pen "black" 2 'solid)
+  (send dc set-smoothing 'smoothed)
+
+  (send dc set-pen "black" 2 'solid)
   (send dc set-brush (make-color 200 200 200) 'solid)
 
   (define p (new dc-path%))
@@ -60,5 +64,5 @@
 
 (file)
 (folder)
-
 |#
+