805c168236
* use it to have the search files as externals (which is significantly faster on some browsers (IE)) svn: r10089
90 lines
3.2 KiB
Scheme
90 lines
3.2 KiB
Scheme
#reader scribble/reader
|
|
#lang scheme/base
|
|
|
|
(require "../config.ss"
|
|
scribble/manual
|
|
scribble/struct
|
|
scribble/decode
|
|
scheme/list
|
|
setup/dirs)
|
|
|
|
(provide main-page script script-ref)
|
|
|
|
(define page-info
|
|
(let ([links (filter pair? links)])
|
|
(lambda (id)
|
|
(cond [(assq id links) => cdr]
|
|
[else (error 'main-page "page id not found: ~e" id)]))))
|
|
|
|
(define (script #:noscript [noscript null] . body)
|
|
(make-script-element #f noscript "text/javascript" (flatten body)))
|
|
|
|
(define (script-ref #:noscript [noscript null] path)
|
|
(make-script-element #f noscript "text/javascript" path))
|
|
|
|
;; the second argument specifies installation/user specific, and if
|
|
;; it's missing, then it's a page with a single version
|
|
(define (main-page id [installation-specific? '?])
|
|
(define info (page-info id))
|
|
(define title-string (car info))
|
|
(define root (cadr info))
|
|
(define path (caddr info))
|
|
(define user-doc? (eq? installation-specific? #f))
|
|
(define inst-doc? (eq? installation-specific? #t))
|
|
(define up-path
|
|
;; massage the current path to an up string
|
|
(regexp-replace* #rx"[^/]*/" (regexp-replace #rx"[^/]+$" path "") "../"))
|
|
(define page-title
|
|
(title #:style '(no-toc) title-string
|
|
(cond [inst-doc? " (installation)"]
|
|
[user-doc? ""] ; can be " (user)"
|
|
[else ""])))
|
|
(define toc
|
|
(map (lambda (item)
|
|
(let ([link-id (if (pair? item) (car item) item)])
|
|
((if (eq? id link-id) caddr cadr) item)))
|
|
(front-toc-items up-path)))
|
|
(make-splice `(,page-title
|
|
,@toc
|
|
,@(if user-doc?
|
|
(list @script{SetPLTRoot("@(version)", "@up-path")@";"})
|
|
'()))))
|
|
|
|
;; FIXME: Use this to avoid hard-wiring manual titles and paths in config.ss
|
|
(define (resolve s [f s])
|
|
(resolved-module-path-name
|
|
(module-path-index-resolve
|
|
(module-path-index-join `(lib ,(format "scribblings/~a/~a.scrbl" s f))
|
|
#f))))
|
|
|
|
(define (front-toc-items up)
|
|
(map (lambda (item)
|
|
(if (eq? item '---)
|
|
(list '--- (make-toc-element #f null '(nbsp)))
|
|
(let ()
|
|
(define id (car item))
|
|
(define info (page-info id))
|
|
(define label (car info))
|
|
(define root (cadr info))
|
|
(define path (caddr info))
|
|
(define text (make-element "tocsubseclink" (list label)))
|
|
(define dest
|
|
(case root
|
|
[(plt) (build-path (find-doc-dir) path)]
|
|
[(user) (string-append up path)]
|
|
[(#f) path]
|
|
[else (error "internal error (main-page)")]))
|
|
(define (onclick style)
|
|
(if (eq? root 'user)
|
|
(make-with-attributes
|
|
style
|
|
`([onclick
|
|
. ,(format "return GotoPLTRoot(\"~a\", \"~a\");"
|
|
(version) path)]))
|
|
style))
|
|
(define (elt style)
|
|
(make-toc-element
|
|
#f null (list (link dest #:style (onclick style) text))))
|
|
(list id (elt "tocviewlink") (elt "tocviewselflink")))))
|
|
links))
|