Toplevel download links

This commit is contained in:
Eli Barzilay 2010-06-06 08:43:57 -04:00
parent 2edf998fdb
commit fdd1c8d003
3 changed files with 28 additions and 7 deletions

View File

@ -162,7 +162,8 @@
[(_ dir) [(_ dir)
(with-syntax ([page-id (datum->syntax stx 'page)] (with-syntax ([page-id (datum->syntax stx 'page)]
[plain-id (datum->syntax stx 'plain)] [plain-id (datum->syntax stx 'plain)]
[copyfile-id (datum->syntax stx 'copyfile)]) [copyfile-id (datum->syntax stx 'copyfile)]
[symlink-id (datum->syntax stx 'symlink)])
#`(begin #`(begin
(define resources (define resources
(make-resources (make-icon dir) (make-logo dir) (make-style dir))) (make-resources (make-icon dir) (make-logo dir) (make-style dir)))
@ -172,8 +173,10 @@
(plain #:dir dir . xs)) (plain #:dir dir . xs))
(define (copyfile-id source [target #f] [referrer values]) (define (copyfile-id source [target #f] [referrer values])
(copyfile-resource source target referrer #:dir dir)) (copyfile-resource source target referrer #:dir dir))
(define (symlink-id source [target #f] [referrer values])
(symlink-resource source target referrer #:dir dir))
#,@(if provide? #,@(if provide?
#'((provide page-id plain-id copyfile-id)) #'((provide page-id plain-id copyfile-id symlink-id))
'())))])) '())))]))
(define-syntax (define+provide-context stx) (define-syntax (define+provide-context stx)
(make-define+provide-context stx #t)) (make-define+provide-context stx #t))

View File

@ -12,12 +12,17 @@
'in-here "missing source information" stx)))]) 'in-here "missing source information" stx)))])
#`(build-path '#,src path paths ...))])) #`(build-path '#,src path paths ...))]))
(provide copyfile-resource) (define ((make-path-resourcer file-op)
(define (copyfile-resource source [target #f] [referrer values] #:dir [dir #f]) source [target #f] [referrer values] #:dir [dir #f])
(let ([target (or target (let-values ([(base file dir?) (split-path source)]) (let ([target (or target (let-values ([(base file dir?) (split-path source)])
(path->string file)))]) (path->string file)))])
(resource (if dir (web-path dir target) target) (resource (if (eq? void file-op)
(lambda (file) (copy-file source file)) referrer))) (void) (if dir (web-path dir target) target))
(lambda (file) (file-op source file)) referrer)))
(provide copyfile-resource symlink-resource)
(define copyfile-resource (make-path-resourcer copy-file))
(define symlink-resource (make-path-resourcer make-file-or-directory-link))
(provide web-path) (provide web-path)
(define (web-path . xs) (define (web-path . xs)

View File

@ -1,6 +1,19 @@
#lang at-exp s-exp "shared.rkt" #lang at-exp s-exp "shared.rkt"
(require racket/string "data.rkt")
(define (in-ftp . paths)
(string-join (cons "/var/ftp/pub/racket" paths) "/"))
(define docs (symlink (in-ftp "docs")))
(define installers (symlink (in-ftp "installers")))
(provide index) (provide index)
(define index (define index
(page #:link-title "Download" #:window-title "Download Racket" (page #:link-title "Download" #:window-title "Download Racket"
"TODO")) @ul{@li{Current @a[href: `(,installers "/recent")]{installers}
(or @a[href: installers]{all versions}).}
@li{Current documentation in
@a[href: `(,docs "/recent/html")]{HTML} and in
@a[href: `(,docs "/recent/pdf")]{PDF}
(or @a[href: docs]{all versions}).}}))