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

Better code to generate main page titles and toc

Browse Source 
svn: r9955
This commit is contained in:
Eli Barzilay 2008-05-26 09:19:38 +00:00
parent ed3dcd6ecd
commit baf80c5849
11 changed files with 135 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/scribblings/main/acks.scrbl
View File

@ -1,11 +1,9 @@
#lang scribble/doc
@(require scribble/manual
drscheme/acks
"private/front-toc.ss")
"private/utils.ss")
@title[#:style '(no-toc)]{Acknowledgements}
@front-toc['acks #f]
@main-page['acks]
@(get-general-acks)

21
collects/scribblings/main/config.ss
View File

@ -4,6 +4,27 @@
;; Configuration of various parts of the main pages
(define bug-url "http://bugs.plt-scheme.org/")
;; Link definitions: (id-sym title root-sym/#f-for-url subpath/url),
;; or a `---' for a spacer; the root-sym can be `plt' for standard
;; pages, or `user' for pages that have an installation and a
;; user-specific version (and navigating to them should get to the
;; user-specific pages using cookies). (Note: the subpath must match
;; where the corresponding document is generated, this is a hack.)
(define links
`((start "PLT Manuals" user "index.html")
(search "Search Manuals" user "search/index.html")
---
(index "Master Index" user "master-index/index.html")
---
(license "License" plt "license/index.html")
(acks "Acknowledgements" plt "acks/index.html")
(release "Release Notes" plt "release/index.html")
---
(bugreport "Report a Bug" #f ,(format "~a?v=~a" bug-url (version)))))
;; Section definitions for manuals that appear on the start page.
(define manual-sections
'((getting-started "Getting Started")
(language "Languages")

6
collects/scribblings/main/license.scrbl
View File

@ -1,12 +1,10 @@
#lang scribble/doc
@(require scribble/manual
"private/front-toc.ss")
"private/utils.ss")
@(define (copyright . strs) (apply verbatim #:indent 2 strs))
@front-toc['license #f]
@title[#:style '(no-toc)]{License}
@main-page['license]
PLT software and documentation is distributed under the GNU Lesser
General Public License (LGPL). This means

6
collects/scribblings/main/master-index.scrbl
View File

@ -1,10 +1,8 @@
#lang scribble/doc
@(require scribble/basic
scribble/decode
"private/front-toc.ss")
"private/utils.ss")
@title[#:style '(no-toc)]{Master Index (installation)}
@front-toc['index #f]
@main-page['index #t]
@(make-splice (index-blocks))

45
collects/scribblings/main/private/front-toc.ss
View File

@ -1,45 +0,0 @@
#lang scheme/base
(require scribble/manual
scribble/struct
scribble/decode
setup/dirs)
(provide front-toc)
(define bug-url "http://bugs.plt-scheme.org/")
(define spacer
(make-toc-element #f null '(nbsp)))
(define ((to-toc here) there target label)
(let* ([elt (make-element "tocsubseclink" (list label))]
[elt (link target #:underline? (eq? here there) elt)])
(make-toc-element #f null (list elt))))
;; FIXME: Use this to avoid hard-wiring manual titles and paths below
(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 here main?)
(define docdir (let ([d (find-doc-dir)]) (lambda (p) (build-path d p))))
(let ([to-toc (to-toc here)]
[up (lambda (s)
(if main?
s
;; This needs to use a cookie(?) to always get to the
;; user-specific page... ?
(string-append "../" s)))])
(make-splice
(list (to-toc 'start (up "index.html") "PLT Scheme Documentation")
(to-toc 'search (up "search/index.html") "Search PLT Manuals")
spacer
(to-toc 'index (up "master-index/index.html") "Master Index")
spacer
(to-toc 'license (docdir "license/index.html") "License")
(to-toc 'acks (docdir "acks/index.html") "Acknowledgments")
(to-toc 'release (docdir "release/index.html") "Release Notes")
spacer
(to-toc #f (format "~a?v=~a" bug-url (version)) "Report a Bug")))))

21
collects/scribblings/main/private/manuals.ss
View File

@ -2,14 +2,12 @@
(require scribble/manual
scribble/struct
scribble/decode
setup/getinfo
setup/main-collects
scheme/list
"front-toc.ss"
"../config.ss")
(provide build-contents)
(provide make-start-page)
(define-struct sec (cat label))
@ -31,7 +29,7 @@
(truncate (/ (caar l) 10))))])
(if sep? (cons (mk-sep lbl) l) l))]))))
(define (build-contents all?)
(define (make-start-page all?)
(let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)]
[docs (append-map
@ -78,10 +76,7 @@
[line
(lambda (doc)
(plain-line (hspace 2) (other-manual doc #:underline? #f)))])
(make-splice
(list
(make-delayed-block
(lambda (renderer part resolve-info)
(define (contents renderer part resolve-info)
(make-table
#f
(cdr
@ -98,8 +93,7 @@
(plain-line
(make-element (if (string=? str "") "sepspace" "septitle")
(list 'nbsp str))))
(sort
(map (lambda (doc)
(sort (map (lambda (doc)
(list (cadr doc) (line (cadddr doc)) (caddr doc)))
docs)
(lambda (ad bd)
@ -107,9 +101,10 @@
(let ([str (lambda (x)
(element->string
(cadr (paragraph-content
(car (flow-paragraphs (caadr x)))))
(car (flow-paragraphs
(caadr x)))))
renderer part resolve-info))])
(string-ci<? (str ad) (str bd)))
(> (car ad) (car bd)))))))))
sections)))))
(front-toc 'start #t)))))
sections))))
(make-delayed-block contents)))

64
collects/scribblings/main/private/utils.ss Normal file
View File

@ -0,0 +1,64 @@
#lang scheme/base
(require "../config.ss"
scribble/manual
scribble/struct
scribble/decode
setup/dirs)
(provide main-page)
(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)]))))
;; 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))
(make-splice (list (title #:style '(no-toc)
(car info)
(case installation-specific?
[(?) ""]
[(#t) " (installation)"]
[(#f) ""])) ; can be " (user)"
(front-toc id))))
;; 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* ([id (car item)]
[info (page-info id)]
[label (car info)]
[root (cadr info)]
[path (caddr info)]
[text (make-element "tocsubseclink" (list label))]
[link (link (case root
[(plt) (build-path (find-doc-dir) path)]
[(user) (string-append up path)]
[(#f) path]
[else (error "internal error (main-page)")])
#:underline? #f text)])
(list id
(make-toc-element #f null (list link))
(make-toc-element #f null (list text))))))
links))
(define (front-toc here)
;; massages the current path to an up string
(let* ([up (regexp-replace #rx"[^/]+$" (caddr (page-info here)) "")]
[up (regexp-replace* #rx"[^/]*/" up "../")])
(make-splice (map (lambda (item)
(let ([id (if (pair? item) (car item) item)])
((if (eq? here id) caddr cadr) item)))
(front-toc-items up)))))

6
collects/scribblings/main/release.scrbl
View File

@ -1,7 +1,7 @@
#lang scribble/doc
@(require scribble/manual
setup/dirs
"private/front-toc.ss")
"private/utils.ss")
@(define (rl-link path . content)
(apply link (apply build-path (find-doc-dir) "release-notes" path)
@ -9,9 +9,7 @@
@(define (mzport doc from to)
(rl-link (list "mzscheme" doc) (format "Porting from ~a to ~a" from to)))
@title[#:style '(no-toc)]{Release Notes}
@front-toc['release #f]
@main-page['release]
@itemize[#:style "compact"]{

5
collects/scribblings/main/start.scrbl
View File

@ -1,13 +1,14 @@
#lang scribble/doc
@(require scribble/manual
scribble/struct
"private/utils.ss"
"private/manuals.ss")
@title[#:style '(no-toc)]{PLT Scheme Documentation (installation)}
@main-page['start #t]
@margin-note{This is an installation-specific listing. Running
@exec{plt-help} may open a different page with local and
user-specific documentation, including documentation for
installed @|PLaneT| packages.}
@(build-contents #f)
@(make-start-page #f)

6
collects/scribblings/main/user/master-index.scrbl
View File

@ -1,10 +1,8 @@
#lang scribble/doc
@(require scribble/basic
scribble/decode
"../private/front-toc.ss")
"../private/utils.ss")
@title[#:style '(no-toc)]{Master Index}
@front-toc['index #f]
@main-page['index #f]
@(make-splice (index-blocks))

5
collects/scribblings/main/user/start.scrbl
View File

@ -1,9 +1,10 @@
#lang scribble/doc
@(require scribble/manual
scribble/struct
"../private/utils.ss"
"../private/manuals.ss")
@title[#:style '(no-toc)]{PLT Scheme Documentation}
@main-page['start #f]
@;{
@; This page should always be the default, so it doesn't need to say
@ -18,4 +19,4 @@
user-specific packages (@|PLaneT| packages and other
collections) that are not in the main installation.}
@(build-contents #t)
@(make-start-page #t)