diff --git a/pkgs/plt-web-pkgs/plt-web-doc/plt-web.scrbl b/pkgs/plt-web-pkgs/plt-web-doc/plt-web.scrbl index d648757356..68874daf28 100644 --- a/pkgs/plt-web-pkgs/plt-web-doc/plt-web.scrbl +++ b/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} diff --git a/pkgs/plt-web-pkgs/plt-web-lib/indexes.rkt b/pkgs/plt-web-pkgs/plt-web-lib/indexes.rkt index b6869f7648..657fac8fb3 100644 --- a/pkgs/plt-web-pkgs/plt-web-lib/indexes.rkt +++ b/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) diff --git a/pkgs/plt-web-pkgs/plt-web-lib/resources/file-icons.rkt b/pkgs/plt-web-pkgs/plt-web-lib/resources/file-icons.rkt index 745c0dda58..146b3c52b2 100644 --- a/pkgs/plt-web-pkgs/plt-web-lib/resources/file-icons.rkt +++ b/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) - |# + diff --git a/pkgs/plt-web-pkgs/plt-web-lib/resources/file.png b/pkgs/plt-web-pkgs/plt-web-lib/resources/file.png index 9e66872bf9..6b8037ad86 100644 Binary files a/pkgs/plt-web-pkgs/plt-web-lib/resources/file.png and b/pkgs/plt-web-pkgs/plt-web-lib/resources/file.png differ diff --git a/pkgs/plt-web-pkgs/plt-web-lib/resources/folder.png b/pkgs/plt-web-pkgs/plt-web-lib/resources/folder.png index 1cd9a38600..8350bcfe12 100644 Binary files a/pkgs/plt-web-pkgs/plt-web-lib/resources/folder.png and b/pkgs/plt-web-pkgs/plt-web-lib/resources/folder.png differ