diff --git a/pkgs/plt-services/meta/new-web/download/indexes.rkt b/pkgs/plt-services/meta/new-web/download/indexes.rkt index b3538f61e9..c3f5bcbe3b 100644 --- a/pkgs/plt-services/meta/new-web/download/indexes.rkt +++ b/pkgs/plt-services/meta/new-web/download/indexes.rkt @@ -18,4 +18,10 @@ #:url "http://download.racket-lang.org/" #:always-abs-url? #t)) -(make-indexes download-site) +(make-indexes download-site + #:use-dir? (lambda (d) + (or (not (path? d)) + (let-values ([(base name dir) (split-path d)]) + ;; Don't go into documentation "HTML" directories: + (not (equal? "html" (path->string name))))))) + 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 07158a9702..d648757356 100644 --- a/pkgs/plt-web-pkgs/plt-web-doc/plt-web.scrbl +++ b/pkgs/plt-web-pkgs/plt-web-doc/plt-web.scrbl @@ -203,13 +203,16 @@ 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?)]) + [#: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 @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 @racket[use-dir?] predicate is called for each directory to determine +whether the directory's subdirectories are traversed. The generated index files are registered for the site @racket[s] at destinations that correspond to treating the current directory as the diff --git a/pkgs/plt-web-pkgs/plt-web-lib/indexes.rkt b/pkgs/plt-web-pkgs/plt-web-lib/indexes.rkt index b42f2b73e9..b6869f7648 100644 --- a/pkgs/plt-web-pkgs/plt-web-lib/indexes.rkt +++ b/pkgs/plt-web-pkgs/plt-web-lib/indexes.rkt @@ -1,11 +1,16 @@ #lang at-exp racket/base (require scribble/html racket/format - "layout.rkt") + racket/runtime-path + "layout.rkt" + "style.rkt") (provide make-indexes) -(define (build site p) +(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 @@ -13,22 +18,34 @@ "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")) - ""))}})})))) + @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) + 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")) + ""))}})}})))) (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))))))) + #: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)) + (let loop ([dir dir] [depth depth]) + (build site dir file-icon folder-icon) + (when (and (or (not depth) (positive? depth)) + (use-dir? dir)) + (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) + (loop p (and depth (sub1 depth)))))))) 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 new file mode 100644 index 0000000000..745c0dda58 --- /dev/null +++ b/pkgs/plt-web-pkgs/plt-web-lib/resources/file-icons.rkt @@ -0,0 +1,64 @@ +#lang racket/base +#| +;; This is how "file.png" and "folder.png" were generated, but it's commented +;; out here to avoid a dependency on `racket/draw`. +(require racket/class + racket/math + racket/draw) + +(define S 32) + +(define (file) + (define bm (make-bitmap S S)) + (define dc (send bm make-dc)) + + (define I 3) + + (send dc set-pen "black" 2 'solid) + (send dc set-brush (make-color 200 200 200) 'solid) + (send dc draw-polygon (list + (cons 6 I) + (cons 6 (- S I)) + (cons (- S 6) (- S I)) + (cons (- S 6) (+ 8 I)) + (cons (- S 14) I)) + 0 1) + + (send dc set-brush (make-color 150 150 150) 'solid) + (send dc draw-polygon (list + (cons (- S 14) (+ 8 I)) + (cons (- S 6) (+ 8 I)) + (cons (- S 14) I)) + 0 1) + + (send bm save-file "/tmp/file.png" 'png #:unscaled? #t)) + +(define (folder) + (define bm (make-bitmap S S)) + (define dc (send bm make-dc)) + + (define D 8) + (define H 12) + (define T (/ D 2)) + + (send dc set-pen "black" 2 'solid) + (send dc set-brush (make-color 200 200 200) 'solid) + + (define p (new dc-path%)) + (send p arc (+ 1 T) (- S D 1 H T) D D 0 (* 1/2 pi) #t) + (send p arc 1 (- S D 1 H T) D D (* 1/2 pi) (* 1 pi) #t) + (send p line-to 1 (- S 1)) + ;; (send p arc 1 (- S D 1) D D (* -1 pi) (* -1/2 pi) #t) + (send p line-to (- S 1) (- S 1)) + ;; (send p arc (- S D 1) (- S D 1) D D (* -1/2 pi) 0 #t) + (send p arc (- S D 1) (- S D 1 H) D D 0 (* 1/2 pi) #t) + (send p close) + + (send dc draw-path p 0 0) + + (send bm save-file "/tmp/folder.png" 'png #:unscaled? #t)) + +(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 new file mode 100644 index 0000000000..9e66872bf9 Binary files /dev/null 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 new file mode 100644 index 0000000000..1cd9a38600 Binary files /dev/null and b/pkgs/plt-web-pkgs/plt-web-lib/resources/folder.png differ diff --git a/pkgs/plt-web-pkgs/plt-web-lib/style.rkt b/pkgs/plt-web-pkgs/plt-web-lib/style.rkt index 7f28514932..5bc40c11b9 100644 --- a/pkgs/plt-web-pkgs/plt-web-lib/style.rkt +++ b/pkgs/plt-web-pkgs/plt-web-lib/style.rkt @@ -1,4 +1,6 @@ -#lang plt-web +#lang at-exp racket/base + +(require (except-in scribble/html/lang #%module-begin)) (provide (all-defined-out))