diff --git a/collects/compiler/cm.ss b/collects/compiler/cm.ss index e489f2109e..edf563a1c5 100644 --- a/collects/compiler/cm.ss +++ b/collects/compiler/cm.ss @@ -10,7 +10,7 @@ make-caching-managed-compile-zo trust-existing-zos manager-compile-notify-handler - ;manager-skip-file-handler ;; not yet tested, so not yet exported + manager-skip-file-handler (rename-out [trace manager-trace-handler])) (define manager-compile-notify-handler (make-parameter void)) diff --git a/collects/compiler/compiler-unit.ss b/collects/compiler/compiler-unit.ss index ba8911f651..6037b8cd71 100644 --- a/collects/compiler/compiler-unit.ss +++ b/collects/compiler/compiler-unit.ss @@ -144,9 +144,14 @@ (let ([zo (append-zo-suffix b)]) (compile-to-zo f zo n prefix verbose? mod?))))) - (define (compile-directory dir info #:verbose [verbose? #t]) + (define (compile-directory dir info #:verbose [verbose? #t] #:skip-path [orig-skip-path #f]) (define info* (or info (lambda (key mk-default) (mk-default)))) (define omit-paths (omitted-paths dir c-get-info/full)) + (define skip-path (and orig-skip-path (path->bytes + (simplify-path (if (string? orig-skip-path) + (string->path orig-skip-path) + orig-skip-path) + #f)))) (unless (eq? 'all omit-paths) (parameterize ([current-directory dir] [current-load-relative-directory dir] @@ -156,7 +161,14 @@ (lambda (s) (fprintf op "~a\n" s))) (manager-trace-handler))] [manager-compile-notify-handler - (lambda (path) ((compile-notify-handler) path))]) + (lambda (path) ((compile-notify-handler) path))] + [manager-skip-file-handler + (lambda (path) (and skip-path + (let ([b (path->bytes (simplify-path path #f))] + [len (bytes-length skip-path)]) + (and ((bytes-length b) . > . len) + (bytes=? (subbytes b 0 len) skip-path))) + -inf.0))]) (let* ([sses (append ;; Find all .ss/.scm files: (filter extract-base-filename/ss (directory-list)) @@ -173,10 +185,11 @@ (when (and (directory-exists? p*) (not (member p omit-paths))) (compile-directory p* (c-get-info/full p*)))))))) - (define (compile-collection-zos collection . cp) + (define (compile-collection-zos collection #:skip-path [skip-path #f] . cp) (compile-directory (apply collection-path collection cp) (c-get-info (cons collection cp)) - #:verbose #f)) + #:verbose #f + #:skip-path skip-path)) (define compile-directory-zos compile-directory) diff --git a/collects/planet/resolver.ss b/collects/planet/resolver.ss index ffe9ca281e..f00c9bf58e 100644 --- a/collects/planet/resolver.ss +++ b/collects/planet/resolver.ss @@ -210,6 +210,9 @@ subdirectory. ;; if #f, will not install packages and instead give an error (define install? (make-parameter #t)) +;; update doc index only once for a set of installs: +(define planet-nested-install (make-parameter #f)) + ;; ============================================================================= ;; DIAMOND PROPERTY STUFF ;; make sure a module isn't loaded twice with two different versions @@ -535,12 +538,13 @@ subdirectory. (apply build-path (CACHE-DIR) (append (pkg-spec-path pkg) (list (pkg-spec-name pkg) (number->string maj) - (number->string min))))]) + (number->string min))))] + [was-nested? (planet-nested-install)]) (if (directory-exists? the-dir) (raise (make-exn:fail "Internal PLaneT error: trying to install already-installed package" (current-continuation-marks))) - (begin + (parameterize ([planet-nested-install #t]) (planet-terse-log 'install (pkg-spec->string pkg)) (with-logging (LOG-FILE) @@ -551,9 +555,14 @@ subdirectory. ;; oh man is this a bad hack! (parameterize ([current-namespace (make-namespace)]) (let ([ipp (dynamic-require 'setup/plt-single-installer - 'install-planet-package)]) + 'install-planet-package)] + [rud (dynamic-require 'setup/plt-single-installer + 'reindex-user-documentation)]) (ipp path the-dir (list owner (pkg-spec-name pkg) - extra-path maj min)))))) + extra-path maj min)) + (unless was-nested? + (printf "------------- Rebuilding documentation index -------------\n") + (rud)))))) (planet-terse-log 'finish (pkg-spec->string pkg)) (make-pkg (pkg-spec-name pkg) (pkg-spec-path pkg) maj min the-dir 'normal))))) diff --git a/collects/planet/util.ss b/collects/planet/util.ss index d94e7970ee..034ca9d465 100644 --- a/collects/planet/util.ss +++ b/collects/planet/util.ss @@ -124,6 +124,8 @@ (delete-directory/files path) (planet-log "Trimming empty directories") (trim-directory (CACHE-DIR) path) + (planet-log "Rebuilding documentation index") + (reindex-user-documentation) (void)))) ;; erase-metadata : pkg -> void diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 296bcb365f..5ada150b91 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -21,8 +21,6 @@ (provide render-mixin render-multi-mixin) -(xml:empty-tag-shorthand xml:html-empty-tags) - (define literal (let ([loc (xml:make-location 0 0 0)]) (lambda strings (xml:make-cdata loc loc (string-append* strings))))) @@ -616,34 +614,35 @@ (call-with-input-file* prefix-file (lambda (in) (copy-port in (current-output-port)))) - (xml:write-xml/content - (xml:xexpr->xml - `(html () - (head () - (meta ([http-equiv "content-type"] - [content "text-html; charset=utf-8"])) - ,title - ,(scribble-css-contents style-file css-path) - ,@(map (lambda (style-file) - (install-file style-file) - (scribble-css-contents style-file #f)) - (append style-extra-files - (extract-part-style-files - d - ri - 'css - (lambda (p) (part-whole-page? p ri))))) - ,(scribble-js-contents script-file script-path)) - (body ((id ,(or (extract-part-body-id d ri) - "scribble-plt-scheme-org"))) - ,@(render-toc-view d ri) - (div ([class "maincolumn"]) - (div ([class "main"]) - ,@(parameterize ([current-version (extract-version d)]) - (render-version d ri)) - ,@(navigation d ri #t) - ,@(render-part d ri) - ,@(navigation d ri #f)))))))))) + (parameterize ([xml:empty-tag-shorthand xml:html-empty-tags]) + (xml:write-xml/content + (xml:xexpr->xml + `(html () + (head () + (meta ([http-equiv "content-type"] + [content "text-html; charset=utf-8"])) + ,title + ,(scribble-css-contents style-file css-path) + ,@(map (lambda (style-file) + (install-file style-file) + (scribble-css-contents style-file #f)) + (append style-extra-files + (extract-part-style-files + d + ri + 'css + (lambda (p) (part-whole-page? p ri))))) + ,(scribble-js-contents script-file script-path)) + (body ((id ,(or (extract-part-body-id d ri) + "scribble-plt-scheme-org"))) + ,@(render-toc-view d ri) + (div ([class "maincolumn"]) + (div ([class "main"]) + ,@(parameterize ([current-version (extract-version d)]) + (render-version d ri)) + ,@(navigation d ri #t) + ,@(render-part d ri) + ,@(navigation d ri #f))))))))))) (define/private (part-parent d ri) (collected-info-parent (part-collected-info d ri))) diff --git a/collects/scribblings/main/info.ss b/collects/scribblings/main/info.ss index 28faa2f7d1..c822081879 100644 --- a/collects/scribblings/main/info.ss +++ b/collects/scribblings/main/info.ss @@ -3,12 +3,8 @@ (define scribblings '(("start.scrbl" (main-doc-root always-run depends-all-main no-depend-on) (omit)) - ("user/start.scrbl" - (user-doc-root always-run depends-all no-depend-on) (omit)) ("search.scrbl" (depends-all-main no-depend-on) (omit)) ("master-index.scrbl" (depends-all-main no-depend-on) (omit)) - ("user/search.scrbl" (user-doc depends-all no-depend-on) (omit)) - ("user/master-index.scrbl" (user-doc depends-all no-depend-on) (omit)) ("getting-started.scrbl" () (omit)) ("license.scrbl" () (omit)) ("acks.scrbl" () (omit)) diff --git a/collects/scribblings/main/user/info.ss b/collects/scribblings/main/user/info.ss new file mode 100644 index 0000000000..e1a14bf6d2 --- /dev/null +++ b/collects/scribblings/main/user/info.ss @@ -0,0 +1,6 @@ +#lang setup/infotab + +(define scribblings + '(("start.scrbl" (user-doc-root always-run depends-all no-depend-on) (omit)) + ("search.scrbl" (user-doc depends-all no-depend-on) (omit)) + ("master-index.scrbl" (user-doc depends-all no-depend-on) (omit)))) diff --git a/collects/scribblings/mzc/make.scrbl b/collects/scribblings/mzc/make.scrbl index afbb6b1092..05601e8d77 100644 --- a/collects/scribblings/mzc/make.scrbl +++ b/collects/scribblings/mzc/make.scrbl @@ -241,21 +241,14 @@ A parameter for a procedure of one argument that is called to report compilation-manager actions, such as checking a file. The argument to the procedure is a string.} -@;{ @defparam[manager-skip-file-handler proc (-> path? (or/c number? #f))]{ - This handler is consulted for each file that is loaded. If it - returns a number, then the file is skipped (ie, not compiled), - and the number is used as the timestamp. If it returns @scheme[#f], - then the file is compiled (if necessary) as usual. -@;{Defaults to a function that checks to see if the module in the file - has already been loaded in the filesystem and, if it has, it - returns the timestamp of the .zo file for that file (or the .ss file - if the .zo file does not exist).} - - Defaults to @scheme[(λ (x) #f)]. -} -} +A parameter whose value is called for each file that is loaded and + needs recompilation. If the procedure returns a number, then the file + is skipped (i.e., not compiled), and the number is used as the + timestamp for the file's bytecode. If the procedure returns + @scheme[#f], then the file is compiled as usual. The default is + @scheme[(lambda (x) #f)].} @; ---------------------------------------------------------------------- diff --git a/collects/scribblings/setup-plt/setup-plt.scrbl b/collects/scribblings/setup-plt/setup-plt.scrbl index 45922afda7..4bb2725cb3 100644 --- a/collects/scribblings/setup-plt/setup-plt.scrbl +++ b/collects/scribblings/setup-plt/setup-plt.scrbl @@ -389,7 +389,7 @@ initialized between them, e.g.: _...) ] -@subsubsection{@|setup-plt| Unit} +@subsection{@|setup-plt| Unit} @defmodule[setup/setup-unit] @@ -459,6 +459,10 @@ form.} If on, update @filepath{info-domain/compiled/cache.ss} for each collection path. @defaults[@scheme[#t]]} +@defboolparam[avoid-main-installation on?]{ + If on, avoid building bytecode in the main installation tree when building + other bytecode (e.g., in a user-specific collection). @defaults[@scheme[#f]]} + @defboolparam[call-install on?]{ If on, call collection @filepath{info.ss}-specified setup code. @defaults[@scheme[#t]]} @@ -480,6 +484,11 @@ form.} by the archives are set-up in addition to the collections listed in specific-collections. @defaults[@scheme[null]]} +@defboolparam[archive-implies-reindex on?]{ + If on, when @scheme[archives] has a non-empty list of packages, if any + documentation is built, then suitable documentation start pages, search pages, + and master index pages are re-built. @defaults[@scheme[#t]]} + @defparam[current-target-directory-getter thunk (-> . path-string?)]{ A thunk that returns the target directory for unpacking a relative @filepath{.plt} archive; when unpacking an archive, either this or @@ -694,7 +703,7 @@ for making @filepath{.plt} archives:} The @schememodname[setup/plt-single-installer] module provides a function for installing a single @filepath{.plt} file, and -@schememodname[setup/plt-single-installer] wraps it with a GUI +@schememodname[setup/plt-installer] wraps it with a GUI interface. @subsubsection{Non-GUI Installer} @@ -717,7 +726,37 @@ interface. The @scheme[get-dir-proc] procedure is called if the installer needs a target directory for installation, and a @scheme[#f] result means that the user canceled the installation. Typically, @scheme[get-dir-proc] is - @scheme[current-directory].}} + @scheme[current-directory].} + +@defproc[(install-planet-package [file path-string?] + [directory path-string?] + [spec (list/c string? string? + (listof string?) + exact-nonnegative-integer? + exact-nonnegative-integer?)]) + void?]{ + + Similar to @scheme[run-single-installer], but runs the setup process + to install the archive @scheme[file] into @scheme[directory] as the + @|PLaneT| package described by @scheme[spec]. The user-specific + documentation index is not rebuilt, so @scheme[reindex-user-documentation] + should be run after a set of @|PLaneT| packages are installed.} + +@defproc[(reindex-user-documentation) void?]{ + Similar to @scheme[run-single-installer], but runs only the part of + the setup process that rebuilds the user-specific documentation + start page, search page, and master index.} + +@defproc[(clean-planet-package [directory path-string?] + [spec (list/c string? string? + (listof string?) + exact-nonnegative-integer? + exact-nonnegative-integer?)]) + void?]{ + Undoes the work of @scheme[install-planet-package]. The user-specific + documentation index is not rebuilt, so @scheme[reindex-user-documentation] + should be run after a set of @|PLaneT| packages are removed.}} + @subsubsection[#:tag "gui-unpacking"]{GUI Installer} @@ -754,7 +793,8 @@ interface. @defproc[(run-single-installer (file path-string?) (get-dir-proc (-> (or/c path-string? false/c)))) void?]{ - The same as the sole export of @schememodname[setup/plt-single-installer], but with a GUI.} + The same as the export from @schememodname[setup/plt-single-installer], + but with a GUI.} @; ---------------------------------------- diff --git a/collects/setup/option-sig.ss b/collects/setup/option-sig.ss index 0bbdfe9b19..79cb5cd4b0 100644 --- a/collects/setup/option-sig.ss +++ b/collects/setup/option-sig.ss @@ -16,6 +16,7 @@ make-docs make-user make-planet + avoid-main-installation call-install call-post-install pause-on-errors @@ -24,5 +25,6 @@ specific-collections specific-planet-dirs archives + archive-implies-reindex current-target-directory-getter current-target-plt-directory-getter))) diff --git a/collects/setup/option-unit.ss b/collects/setup/option-unit.ss index 82a576d96c..7f862212be 100644 --- a/collects/setup/option-unit.ss +++ b/collects/setup/option-unit.ss @@ -34,6 +34,7 @@ (define-flag-param make-docs #t) (define-flag-param make-user #t) (define-flag-param make-planet #t) + (define-flag-param avoid-main-installation #f) (define-flag-param call-install #t) (define-flag-param call-post-install #t) (define-flag-param pause-on-errors #f) @@ -44,6 +45,7 @@ (define specific-planet-dirs (make-parameter null)) (define archives (make-parameter null)) + (define archive-implies-reindex (make-parameter #t)) (define current-target-directory-getter (make-parameter current-directory)) (define current-target-plt-directory-getter diff --git a/collects/setup/plt-single-installer.ss b/collects/setup/plt-single-installer.ss index 0b54d4842f..864ffbcb11 100644 --- a/collects/setup/plt-single-installer.ss +++ b/collects/setup/plt-single-installer.ss @@ -14,27 +14,32 @@ compiler/option-unit compiler/compiler-unit) - (provide run-single-installer install-planet-package clean-planet-package) + (provide run-single-installer install-planet-package clean-planet-package reindex-user-documentation) ;; run-single-installer : string (-> string) -> void ;; runs the instealler on the given package (define (run-single-installer file get-target-dir) - (run-single-installer/internal file get-target-dir #f #f)) + (run-single-installer/internal file get-target-dir #f #f #f)) ;; install-planet-package : path path (list string string (listof string) nat nat) -> void ;; unpacks and installs the given planet package into the given path (define (install-planet-package file directory spec) - (run-single-installer/internal file (lambda () directory) (cons directory spec) #f)) + (run-single-installer/internal file (lambda () directory) (cons directory spec) #f #f)) ;; clean-planet-package : path (list string string (listof string) nat nat) -> void ;; cleans the given planet package (define (clean-planet-package directory spec) - (run-single-installer/internal #f (lambda () directory) (cons directory spec) #t)) - + (run-single-installer/internal #f (lambda () directory) (cons directory spec) #f #t)) + + ;; reindex-user-documentation + ;; call after installing or uninstalling a set of Planet packages + (define (reindex-user-documentation) + (run-single-installer/internal #f current-directory #f '(("scribblings/main/user")) #f)) + ;; run-single-installer : string (-> string) (list path string string nat nat) -> void ;; creates a separate thread, runs the installer in that thread, ;; returns when the thread completes - (define (run-single-installer/internal file get-target-dir planet-spec clean?) + (define (run-single-installer/internal file get-target-dir planet-spec collections clean?) (let ([cust (make-custodian)]) (parameterize ([current-custodian cust] [current-namespace (make-namespace)] @@ -47,8 +52,10 @@ (export) ;; >>>>>>>>>>>>>> <<<<<<<<<<<<<<< ;; Here's where we tell setup the archive file! - (unless clean? - (archives (list file))) + (unless (or clean? (not file)) + (archives (list file)) + (when planet-spec + (archive-implies-reindex #f))) ;; Here's where we make get a directory: (current-target-directory-getter @@ -56,13 +63,17 @@ (when planet-spec (specific-planet-dirs (list planet-spec))) + + (when collections + (specific-collections collections)) (when clean? (clean #t) (make-zo #f) (make-launchers #f) (make-info-domain #t) - (call-install #f))) + (call-install #f) + (make-docs #f))) (invoke-unit (compound-unit/infer (import) diff --git a/collects/setup/setup-cmdline.ss b/collects/setup/setup-cmdline.ss index 7677670605..9e04d7c926 100644 --- a/collects/setup/setup-cmdline.ss +++ b/collects/setup/setup-cmdline.ss @@ -50,6 +50,8 @@ (add-flags '((make-user #f) (make-planet #f)))] [("--no-planet") "Do not setup PLaneT packages" (add-flags '((make-planet #f)))] + [("--avoid-main") "Do not make main-installation files" + (add-flags '((avoid-main-installation #t)))] [("-v" "--verbose") "See names of compiled files and info printfs" (add-flags '((verbose #t)))] [("-m" "--make-verbose") "See make and compiler usual messages" diff --git a/collects/setup/setup-unit.ss b/collects/setup/setup-unit.ss index 1f80ecac3c..f92bbb6974 100644 --- a/collects/setup/setup-unit.ss +++ b/collects/setup/setup-unit.ss @@ -646,6 +646,10 @@ ;; Make zo ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (define compile-skip-directory + (and (avoid-main-installation) + (find-collects-dir))) + (when (make-zo) (setup-printf #f "--- compiling collections ---") (with-specified-mode @@ -667,7 +671,7 @@ (setup-fprintf (current-error-port) #f " deleting ~a" (build-path c p)) (delete-file (build-path c p)))))))) ;; Make .zos - (compile-directory-zos dir info)) + (compile-directory-zos dir info #:skip-path compile-skip-directory)) make-base-empty-namespace)))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -797,7 +801,8 @@ (with-handlers ([exn:fail? (lambda (exn) (setup-printf #f "docs failure: ~a" (exn->string exn)))]) - (doc:setup-scribblings #f (not (null? (archives)))))) + (doc:setup-scribblings #f (and (not (null? (archives))) + (archive-implies-reindex))))) (when (doc-pdf-dest) (setup-printf #f "building PDF documentation (via pdflatex)")