suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

plt-web: improve index-page rendering

Browse Source
This commit is contained in:
Matthew Flatt 2014-03-11 17:10:51 -06:00
parent d459900f45
commit 3f35bff34c
7 changed files with 114 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/plt-services/meta/new-web/download/indexes.rkt
View File

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

5
pkgs/plt-web-pkgs/plt-web-doc/plt-web.scrbl
View File

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

55
pkgs/plt-web-pkgs/plt-web-lib/indexes.rkt
View File

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

64
pkgs/plt-web-pkgs/plt-web-lib/resources/file-icons.rkt Normal file
View File

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

BIN
pkgs/plt-web-pkgs/plt-web-lib/resources/file.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 203 B

BIN
pkgs/plt-web-pkgs/plt-web-lib/resources/folder.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 188 B

4
pkgs/plt-web-pkgs/plt-web-lib/style.rkt
View File

@ -1,4 +1,6 @@
#lang plt-web
#lang at-exp racket/base
(require (except-in scribble/html/lang #%module-begin))
(provide (all-defined-out))