diff --git a/collects/scribblings/main/acks.scrbl b/collects/scribblings/main/acks.scrbl index 687d3f5f35..64caf9502e 100644 --- a/collects/scribblings/main/acks.scrbl +++ b/collects/scribblings/main/acks.scrbl @@ -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) diff --git a/collects/scribblings/main/config.ss b/collects/scribblings/main/config.ss index 7071504ac3..a296b9091c 100644 --- a/collects/scribblings/main/config.ss +++ b/collects/scribblings/main/config.ss @@ -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") diff --git a/collects/scribblings/main/license.scrbl b/collects/scribblings/main/license.scrbl index 10f828d38e..7464ad64ae 100644 --- a/collects/scribblings/main/license.scrbl +++ b/collects/scribblings/main/license.scrbl @@ -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 diff --git a/collects/scribblings/main/master-index.scrbl b/collects/scribblings/main/master-index.scrbl index 31753865c7..91033fed44 100644 --- a/collects/scribblings/main/master-index.scrbl +++ b/collects/scribblings/main/master-index.scrbl @@ -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)) diff --git a/collects/scribblings/main/private/front-toc.ss b/collects/scribblings/main/private/front-toc.ss deleted file mode 100644 index e9f6774d7c..0000000000 --- a/collects/scribblings/main/private/front-toc.ss +++ /dev/null @@ -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"))))) diff --git a/collects/scribblings/main/private/manuals.ss b/collects/scribblings/main/private/manuals.ss index 989167d254..0d37fd97e3 100644 --- a/collects/scribblings/main/private/manuals.ss +++ b/collects/scribblings/main/private/manuals.ss @@ -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,38 +76,35 @@ [line (lambda (doc) (plain-line (hspace 2) (other-manual doc #:underline? #f)))]) - (make-splice - (list - (make-delayed-block - (lambda (renderer part resolve-info) - (make-table - #f - (cdr - (append-map - (lambda (sec) - (let ([docs (filter (lambda (doc) (eq? (car doc) (sec-cat sec))) - docs)]) - (list* - (plain-line (hspace 1)) - (plain-line (sec-label sec)) - (add-sections - (sec-cat sec) - (lambda (str) - (plain-line - (make-element (if (string=? str "") "sepspace" "septitle") - (list 'nbsp str)))) - (sort - (map (lambda (doc) - (list (cadr doc) (line (cadddr doc)) (caddr doc))) - docs) - (lambda (ad bd) - (if (= (car ad) (car bd)) - (let ([str (lambda (x) - (element->string - (cadr (paragraph-content - (car (flow-paragraphs (caadr x))))) - renderer part resolve-info))]) - (string-ci (car ad) (car bd))))))))) - sections))))) - (front-toc 'start #t))))) + (define (contents renderer part resolve-info) + (make-table + #f + (cdr + (append-map + (lambda (sec) + (let ([docs (filter (lambda (doc) (eq? (car doc) (sec-cat sec))) + docs)]) + (list* + (plain-line (hspace 1)) + (plain-line (sec-label sec)) + (add-sections + (sec-cat sec) + (lambda (str) + (plain-line + (make-element (if (string=? str "") "sepspace" "septitle") + (list 'nbsp str)))) + (sort (map (lambda (doc) + (list (cadr doc) (line (cadddr doc)) (caddr doc))) + docs) + (lambda (ad bd) + (if (= (car ad) (car bd)) + (let ([str (lambda (x) + (element->string + (cadr (paragraph-content + (car (flow-paragraphs + (caadr x))))) + renderer part resolve-info))]) + (string-ci (car ad) (car bd))))))))) + sections)))) + (make-delayed-block contents))) diff --git a/collects/scribblings/main/private/utils.ss b/collects/scribblings/main/private/utils.ss new file mode 100644 index 0000000000..9e0b00a7cb --- /dev/null +++ b/collects/scribblings/main/private/utils.ss @@ -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))))) diff --git a/collects/scribblings/main/release.scrbl b/collects/scribblings/main/release.scrbl index 826ce56640..5bf06d0176 100644 --- a/collects/scribblings/main/release.scrbl +++ b/collects/scribblings/main/release.scrbl @@ -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"]{ diff --git a/collects/scribblings/main/start.scrbl b/collects/scribblings/main/start.scrbl index 7d75b7f6b9..20309a785c 100644 --- a/collects/scribblings/main/start.scrbl +++ b/collects/scribblings/main/start.scrbl @@ -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) diff --git a/collects/scribblings/main/user/master-index.scrbl b/collects/scribblings/main/user/master-index.scrbl index 3221d99fcd..95e3eca4f6 100644 --- a/collects/scribblings/main/user/master-index.scrbl +++ b/collects/scribblings/main/user/master-index.scrbl @@ -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)) diff --git a/collects/scribblings/main/user/start.scrbl b/collects/scribblings/main/user/start.scrbl index ae00634ca4..22c4ccdc89 100644 --- a/collects/scribblings/main/user/start.scrbl +++ b/collects/scribblings/main/user/start.scrbl @@ -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)