From 1c16d5829ee5c7033922b3f82e23ec7bc8883fa3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 11 Jan 2008 23:13:11 +0000 Subject: [PATCH] add support for user-specific documentation list svn: r8306 --- collects/help/search.ss | 7 +- collects/scribble/scribble.css | 4 - .../scribblings/reference/define-struct.scrbl | 1 + collects/scribblings/start/manuals.ss | 115 ++++++++++++++++++ collects/scribblings/start/start.scrbl | 105 +--------------- collects/scribblings/user-start/info.ss | 4 + .../scribblings/user-start/user-start.scrbl | 12 ++ collects/setup/scribble.ss | 66 ++++++++-- collects/setup/setup-unit.ss | 6 +- 9 files changed, 199 insertions(+), 121 deletions(-) create mode 100644 collects/scribblings/start/manuals.ss create mode 100644 collects/scribblings/user-start/info.ss create mode 100644 collects/scribblings/user-start/user-start.scrbl diff --git a/collects/help/search.ss b/collects/help/search.ss index 1a57f9992e..d3cfd3330d 100644 --- a/collects/help/search.ss +++ b/collects/help/search.ss @@ -18,8 +18,11 @@ [send-main-page (-> void?)]) (define (send-main-page) - (let ([dest-path (build-path (find-doc-dir) "index.html")]) - (send-url (format "file://~a" (path->string dest-path))))) + (let ([user-dest-path (build-path (find-user-doc-dir) "index.html")] + [dest-path (build-path (find-doc-dir) "index.html")]) + (send-url (format "file://~a" (path->string (if (file-exists? user-dest-path) + user-dest-path + dest-path)))))) ;; if there is exactly one exact match for this search key, go directly ;; to that place. Otherwise, go to a page that lists all of the matches. diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css index 24b2137b92..998a24032e 100644 --- a/collects/scribble/scribble.css +++ b/collects/scribble/scribble.css @@ -374,10 +374,6 @@ i { vertical-align: top; } -.centered { - horiz-align: center; /* not right */ -} - .ghost { color: white; } diff --git a/collects/scribblings/reference/define-struct.scrbl b/collects/scribblings/reference/define-struct.scrbl index b76163a7c1..91e2660e34 100644 --- a/collects/scribblings/reference/define-struct.scrbl +++ b/collects/scribblings/reference/define-struct.scrbl @@ -4,6 +4,7 @@ (for-label scheme/serialize)) @(define posn-eval (make-base-eval)) +@interaction-eval[#:eval posn-eval (require (for-syntax scheme/base))] @title[#:tag "define-struct"]{Defining Structure Types: @scheme[define-struct]} diff --git a/collects/scribblings/start/manuals.ss b/collects/scribblings/start/manuals.ss new file mode 100644 index 0000000000..46304529ff --- /dev/null +++ b/collects/scribblings/start/manuals.ss @@ -0,0 +1,115 @@ +#lang scheme/base + +(require scribble/manual + scribble/struct + setup/getinfo + setup/main-collects) + +(provide build-contents) + +(define (resolve s) + (resolved-module-path-name + (module-path-index-resolve + (module-path-index-join `(lib ,(string-append s ".scrbl") + "scribblings" + ,s) + #f)))) + +(define-struct sec (cat label)) + +(define sections + (list (make-sec 'getting-started + "Getting Started") + (make-sec 'language + "Languages") + (make-sec 'tool + "Tools") + (make-sec 'library + "Libraries") + (make-sec 'foreign + "Low-Level APIs") + (make-sec 'other + "Other"))) + +(define (main-collects? dir) + (pair? (path->main-collects-relative dir))) + +(define (build-contents all?) + (let* ([dirs (find-relevant-directories '(scribblings))] + [infos (map get-info/full dirs)] + [docs (apply append + (map (lambda (i dir) + (if (or all? + (main-collects? dir)) + (let ([s (i 'scribblings)]) + (map (lambda (d cat) + (let ([new-cat (if (or (symbol? cat) + (and (list? cat) + (= 2 (length cat)) + (symbol? (car cat)) + (real? (cadr cat)))) + cat + 'unknown)]) + (list + ;; Category + (let ([the-cat (if (list? new-cat) + (car new-cat) + new-cat)]) + (case the-cat + [(getting-started language tool library foreign other omit) + the-cat] + [else + (fprintf (current-error-port) + "WARNING: base category: ~e from: ~e" + cat + dir)])) + ;; Priority + (if (list? new-cat) + (cadr new-cat) + 0) + ;; Path + (if (pair? d) + (build-path dir (car d)) + (build-path dir "???"))))) + s + (i 'doc-categories (lambda () + (map (lambda (i) 'library) s))))) + null)) + infos + dirs))] + [plain-line + (lambda content + (list (make-flow (list (make-paragraph content)))))] + [line + (lambda (doc) + (plain-line (hspace 2) + (other-manual doc #:underline? #f)))]) + (make-delayed-flow-element + (lambda (renderer part resolve-info) + (make-table + #f + (cdr + (apply 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)) + (map + cdr + (sort + (map (lambda (doc) (cons (cadr doc) + (line (caddr doc)))) + docs) + (lambda (ad bd) + (let ([a (cadr (paragraph-content (car (flow-paragraphs (cadr ad)))))] + [b (cadr (paragraph-content (car (flow-paragraphs (cadr bd)))))]) + (if (= (car ad) (car bd)) + (begin + (string-cistring a renderer part resolve-info) + (element->string b renderer part resolve-info))) + (> (car ad) (car bd)))))))))) + sections)))))))) + diff --git a/collects/scribblings/start/start.scrbl b/collects/scribblings/start/start.scrbl index c127e2fc21..a9b647d051 100644 --- a/collects/scribblings/start/start.scrbl +++ b/collects/scribblings/start/start.scrbl @@ -1,107 +1,8 @@ #lang scribble/doc -@require[scribble/manual - scribble/struct - setup/getinfo] +@(require scribble/manual + "manuals.ss") @title{PLT Scheme Documentation} -@begin[ -(define (resolve s) - (resolved-module-path-name - (module-path-index-resolve - (module-path-index-join `(lib ,(string-append s ".scrbl") - "scribblings" - ,s) - #f)))) +@(build-contents #f) -(define-struct sec (cat label)) - -(define sections - (list (make-sec 'getting-started - "Getting Started") - (make-sec 'language - "Languages") - (make-sec 'tool - "Tools") - (make-sec 'library - "Libraries") - (make-sec 'foreign - "Low-Level APIs") - (make-sec 'other - "Other"))) - -(let* ([dirs (find-relevant-directories '(scribblings))] - [infos (map get-info/full dirs)] - [docs (apply append - (map (lambda (i dir) - (let ([s (i 'scribblings)]) - (map (lambda (d cat) - (let ([new-cat (if (or (symbol? cat) - (and (list? cat) - (= 2 (length cat)) - (symbol? (car cat)) - (real? (cadr cat)))) - cat - 'unknown)]) - (list - ;; Category - (let ([the-cat (if (list? new-cat) - (car new-cat) - new-cat)]) - (case the-cat - [(getting-started language tool library foreign other omit) - the-cat] - [else - (fprintf (current-error-port) - "WARNING: base category: ~e from: ~e" - cat - dir)])) - ;; Priority - (if (list? new-cat) - (cadr new-cat) - 0) - ;; Path - (if (pair? d) - (build-path dir (car d)) - (build-path dir "???"))))) - s - (i 'doc-categories (lambda () - (map (lambda (i) 'library) s)))))) - infos - dirs))] - [plain-line - (lambda content - (list (make-flow (list (make-paragraph content)))))] - [line - (lambda (doc) - (plain-line (hspace 2) - (other-manual doc #:underline? #f)))]) - (make-delayed-flow-element - (lambda (renderer part resolve-info) - (make-table - #f - (cdr - (apply 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)) - (map - cdr - (sort - (map (lambda (doc) (cons (cadr doc) - (line (caddr doc)))) - docs) - (lambda (ad bd) - (let ([a (cadr (paragraph-content (car (flow-paragraphs (cadr ad)))))] - [b (cadr (paragraph-content (car (flow-paragraphs (cadr bd)))))]) - (if (= (car ad) (car bd)) - (begin - (string-cistring a renderer part resolve-info) - (element->string b renderer part resolve-info))) - (> (car ad) (car bd)))))))))) - sections))))))) -] diff --git a/collects/scribblings/user-start/info.ss b/collects/scribblings/user-start/info.ss new file mode 100644 index 0000000000..24d5fcf0b3 --- /dev/null +++ b/collects/scribblings/user-start/info.ss @@ -0,0 +1,4 @@ +(module info setup/infotab + (define name "Scribblings: User Start") + (define scribblings '(("user-start.scrbl" (user-doc-root always-run)))) + (define doc-categories '(omit))) diff --git a/collects/scribblings/user-start/user-start.scrbl b/collects/scribblings/user-start/user-start.scrbl new file mode 100644 index 0000000000..1cb41d2b01 --- /dev/null +++ b/collects/scribblings/user-start/user-start.scrbl @@ -0,0 +1,12 @@ +#lang scribble/doc +@(require scribble/manual + "../start/manuals.ss") + +@title{PLT Scheme Documentation (user)} + +@margin-note{This is a user-specific listing, which may include + @|PLaneT| packages and other collections that are not in + the main installation. The main installation's listing is + @other-manual['(lib "scribblings/start/start.scrbl")].} + +@(build-contents #t) diff --git a/collects/setup/scribble.ss b/collects/setup/scribble.ss index 22af4222ae..4717527f61 100644 --- a/collects/setup/scribble.ss +++ b/collects/setup/scribble.ss @@ -23,7 +23,44 @@ vers rendered?) #:mutable) -(define (setup-scribblings only-dirs latex-dest) +(define (user-start-doc? doc) + (memq 'user-doc-root (doc-flags doc))) + +(define (filter-user-start docs) + ;; If we've built it before... + (if (file-exists? (build-path (find-user-doc-dir) "index.html")) + ;; Keep building: + docs + ;; Otherwise, see if we need it: + (let ([cnt-not-main (apply + + (map (lambda (doc) + (if (doc-under-main? doc) + 0 + 1)) + docs))] + [start? (ormap (lambda (doc) + (memq 'main-doc-root (doc-flags doc))) + docs)] + [user-start? (ormap user-start-doc? docs)]) + (let ([any-not-main? (positive? + (- cnt-not-main + (if start? 1 0) + (if user-start? 1 0)))]) + (cond + [any-not-main? + ;; Need it: + docs] + [user-start? + ;; Don't need it, so drop it: + (filter (lambda (doc) (not (user-start-doc? doc))) + docs)] + [else + ;; Wasn't planning to build it, anyway: + docs]))))) + +(define (setup-scribblings only-dirs ; limits doc builds + latex-dest ; if not #f, generate Latex output + auto-start-doc?) ; if #t, expands `only-dir' with [user-]start to catch new docs (let* ([dirs (find-relevant-directories '(scribblings))] [infos (map get-info/full dirs)] [docs (map (lambda (i dir) @@ -39,6 +76,7 @@ (andmap (lambda (i) (member i '(main-doc main-doc-root + user-doc-root multi-page always-run))) (cadr v)) @@ -49,6 +87,7 @@ (map (lambda (d) (let* ([flags (if (pair? (cdr d)) (cadr d) null)] [under-main? (and (not (memq 'main-doc-root flags)) + (not (memq 'user-doc-root flags)) (or (memq 'main-doc flags) (pair? (path->main-collects-relative dir))))]) (make-doc dir @@ -59,11 +98,15 @@ (cadr d) (let-values ([(base name dir?) (split-path (car d))]) (path-replace-suffix name #"")))]) - (if (memq 'main-doc-root flags) - (find-doc-dir) - (if under-main? - (build-path (find-doc-dir) name) - (build-path dir "doc" name)))) + (cond + [(memq 'main-doc-root flags) + (find-doc-dir)] + [(memq 'user-doc-root flags) + (find-user-doc-dir)] + [else + (if under-main? + (build-path (find-doc-dir) name) + (build-path dir "doc" name))])) flags under-main?))) s) @@ -74,9 +117,9 @@ dir) null)))) infos dirs)] - [docs (apply append docs)]) + [docs (filter-user-start (apply append docs))]) (when (ormap (can-build? only-dirs) docs) - (let ([infos (filter values (map (get-doc-info only-dirs latex-dest) docs))]) + (let ([infos (filter values (map (get-doc-info only-dirs latex-dest auto-start-doc?) docs))]) (let loop ([first? #t] [iter 0]) (let ([ht (make-hash-table 'equal)]) ;; Collect definitions @@ -226,7 +269,7 @@ (part-parts v) (and (versioned-part? v) (versioned-part-version v)))))) -(define ((get-doc-info only-dirs latex-dest) doc) +(define ((get-doc-info only-dirs latex-dest auto-start-doc?) doc) (let* ([info-out-file (build-path (or latex-dest (doc-dest-dir doc)) "out.sxref")] [info-in-file (build-path (or latex-dest (doc-dest-dir doc)) "in.sxref")] [out-file (build-path (doc-dest-dir doc) "index.html")] @@ -267,7 +310,7 @@ (fprintf (current-error-port) "~a\n" (exn-message exn)) (delete-file info-out-file) (delete-file info-in-file) - ((get-doc-info only-dirs latex-dest) doc))]) + ((get-doc-info only-dirs latex-dest auto-start-doc?) doc))]) (let* ([v-in (with-input-from-file info-in-file read)] [v-out (with-input-from-file info-out-file read)]) (unless (and (equal? (car v-in) (list vers (doc-flags doc))) @@ -281,7 +324,8 @@ (map rel->path (list-ref v-in 2)) ; deps, in case we don't need to build... can-run? my-time info-out-time - (and can-run? (memq 'always-run (doc-flags doc))) + (and (or can-run? auto-start-doc?) + (memq 'always-run (doc-flags doc))) #f #f vers #f))) diff --git a/collects/setup/setup-unit.ss b/collects/setup/setup-unit.ss index f5f0b3adeb..c2df0cf1c0 100644 --- a/collects/setup/setup-unit.ss +++ b/collects/setup/setup-unit.ss @@ -756,7 +756,8 @@ exn)))]) ((doc:setup-scribblings) (if no-specific-collections? #f (map cc-path ccs-to-compile)) - #f))) + #f + (not (null? (archives)))))) (define (render-pdf file) (define cmd @@ -799,7 +800,8 @@ ((doc:verbose) (verbose)) ((doc:setup-scribblings) (if no-specific-collections? #f (map cc-path ccs-to-compile)) - tmp-dir) + tmp-dir + #f) (parameterize ([current-directory tmp-dir]) (for ([f (directory-list)] #:when (regexp-match? #rx#"[.]tex$" (path-element->bytes f)))