From c5f2e45cf09b06bb468658d80d3d014ea5acecca Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 24 Sep 2009 14:54:15 +0000 Subject: [PATCH] change sandbox to allow read from the planet directory; delay some path calculations in other libraries to avoid sandbox prohibitions (but the ones in Scribble seem like too much) svn: r16122 original commit: eab6803895a05a3ed92eea33b2c4ac1a4652e7ec --- collects/scribble/private/manual-bib.ss | 3 +- collects/scribble/private/manual-proc.ss | 5 +-- collects/scribble/private/manual-sprop.ss | 6 ++-- collects/scribble/private/manual-style.ss | 9 ++--- collects/scribble/private/on-demand.ss | 10 ++++++ collects/scribble/scheme.ss | 43 ++++++++++++----------- 6 files changed, 46 insertions(+), 30 deletions(-) create mode 100644 collects/scribble/private/on-demand.ss diff --git a/collects/scribble/private/manual-bib.ss b/collects/scribble/private/manual-bib.ss index e5c75b69..2e5b70b1 100644 --- a/collects/scribble/private/manual-bib.ss +++ b/collects/scribble/private/manual-bib.ss @@ -3,6 +3,7 @@ "../decode.ss" "../struct.ss" "../basic.ss" + "on-demand.ss" (only-in "../core.ss" make-style) "manual-sprop.ss" "manual-utils.ss" @@ -64,7 +65,7 @@ (if date `(" " ,@(decode-content (list date)) ".") null) (if url `(" " ,(link url (tt url))) null))))) -(define bib-style (make-style "SBibliography" scheme-properties)) +(define-on-demand bib-style (make-style "SBibliography" scheme-properties)) (define (bibliography #:tag [tag "doc-bibliography"] . citations) (make-unnumbered-part diff --git a/collects/scribble/private/manual-proc.ss b/collects/scribble/private/manual-proc.ss index 47879aee..9b8f4bb5 100644 --- a/collects/scribble/private/manual-proc.ss +++ b/collects/scribble/private/manual-proc.ss @@ -13,6 +13,7 @@ "manual-bind.ss" "manual-method.ss" "manual-ex.ss" + "on-demand.ss" scheme/string scheme/list (for-syntax scheme/base) @@ -26,9 +27,9 @@ ;; private: *defthing) ; XXX unknown contract -(define dots0 +(define-on-demand dots0 (make-element meta-color (list "..."))) -(define dots1 +(define-on-demand dots1 (make-element meta-color (list "...+"))) (define (make-openers n) diff --git a/collects/scribble/private/manual-sprop.ss b/collects/scribble/private/manual-sprop.ss index bb205fa8..349a73ce 100644 --- a/collects/scribble/private/manual-sprop.ss +++ b/collects/scribble/private/manual-sprop.ss @@ -2,11 +2,13 @@ (require "../html-properties.ss" "../latex-properties.ss" - setup/main-collects) + "on-demand.ss" + setup/main-collects + scheme/promise) (provide scheme-properties) -(define scheme-properties +(define-on-demand scheme-properties (let ([abs (lambda (s) (path->main-collects-relative (build-path (collection-path "scribble") s)))]) (list (make-css-addition (abs "scheme.css")) diff --git a/collects/scribble/private/manual-style.ss b/collects/scribble/private/manual-style.ss index b8c29339..a47424ae 100644 --- a/collects/scribble/private/manual-style.ss +++ b/collects/scribble/private/manual-style.ss @@ -6,6 +6,7 @@ "../scheme.ss" (only-in "../core.ss" make-style plain) "manual-utils.ss" + "on-demand.ss" scheme/list scheme/contract scheme/string) @@ -28,10 +29,10 @@ onscreen defterm filepath exec envvar Flag DFlag PFlag DPFlag math procedure indexed-file indexed-envvar idefterm pidefterm) +(provide void-const + undefined-const) (provide/contract [PLaneT element?] - [void-const element?] - [undefined-const element?] [hash-lang (-> element?)] [etc string?] [inset-flow (() () #:rest (listof pre-content?) . ->* . any/c)] ; XXX no docs and bad return contract @@ -152,9 +153,9 @@ (list (schememodfont "#lang")) `(part ,(doc-prefix '(lib "scribblings/guide/guide.scrbl") "hash-lang")))) -(define void-const +(define-on-demand void-const (schemeresultfont "#")) -(define undefined-const +(define-on-demand undefined-const (schemeresultfont "#")) (define (link url diff --git a/collects/scribble/private/on-demand.ss b/collects/scribble/private/on-demand.ss new file mode 100644 index 00000000..038db1f1 --- /dev/null +++ b/collects/scribble/private/on-demand.ss @@ -0,0 +1,10 @@ +#lang scheme +(provide define-on-demand) + +(define-syntax-rule (define-on-demand id rhs) + (begin + (define val (delay rhs)) + (define-syntax (id stx) + (if (identifier? stx) + #'(force val) + (raise-syntax-error #f "bad syntax" stx))))) \ No newline at end of file diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss index 9546eae0..be6e3453 100644 --- a/collects/scribble/scheme.ss +++ b/collects/scribble/scheme.ss @@ -3,6 +3,7 @@ "basic.ss" "search.ss" "private/manual-sprop.ss" + "private/on-demand.ss" mzlib/class mzlib/for syntax/modresolve @@ -57,27 +58,27 @@ (cons 'tt-chars scheme-properties) scheme-properties))) - (define output-color (make-scheme-style "ScmOut")) - (define input-color (make-scheme-style "ScmIn")) - (define input-background-color (make-scheme-style "ScmInBG")) - (define no-color (make-scheme-style "ScmPlain")) - (define reader-color (make-scheme-style "ScmRdr")) - (define result-color (make-scheme-style "ScmRes")) - (define keyword-color (make-scheme-style "ScmKw")) - (define comment-color (make-scheme-style "ScmCmt")) - (define paren-color (make-scheme-style "ScmPn")) - (define meta-color (make-scheme-style "ScmMeta")) - (define value-color (make-scheme-style "ScmVal")) - (define symbol-color (make-scheme-style "ScmSym")) - (define variable-color (make-scheme-style "ScmVar")) - (define opt-color (make-scheme-style "ScmOpt")) - (define error-color (make-scheme-style "ScmErr" #:tt? #f)) - (define syntax-link-color (make-scheme-style "ScmStxLink")) - (define value-link-color (make-scheme-style "ScmValLink")) - (define module-color (make-scheme-style "ScmMod")) - (define module-link-color (make-scheme-style "ScmModLink")) - (define block-color (make-scheme-style "ScmBlk")) - (define highlighted-color (make-scheme-style "highlighted" #:tt? #f)) + (define-on-demand output-color (make-scheme-style "ScmOut")) + (define-on-demand input-color (make-scheme-style "ScmIn")) + (define-on-demand input-background-color (make-scheme-style "ScmInBG")) + (define-on-demand no-color (make-scheme-style "ScmPlain")) + (define-on-demand reader-color (make-scheme-style "ScmRdr")) + (define-on-demand result-color (make-scheme-style "ScmRes")) + (define-on-demand keyword-color (make-scheme-style "ScmKw")) + (define-on-demand comment-color (make-scheme-style "ScmCmt")) + (define-on-demand paren-color (make-scheme-style "ScmPn")) + (define-on-demand meta-color (make-scheme-style "ScmMeta")) + (define-on-demand value-color (make-scheme-style "ScmVal")) + (define-on-demand symbol-color (make-scheme-style "ScmSym")) + (define-on-demand variable-color (make-scheme-style "ScmVar")) + (define-on-demand opt-color (make-scheme-style "ScmOpt")) + (define-on-demand error-color (make-scheme-style "ScmErr" #:tt? #f)) + (define-on-demand syntax-link-color (make-scheme-style "ScmStxLink")) + (define-on-demand value-link-color (make-scheme-style "ScmValLink")) + (define-on-demand module-color (make-scheme-style "ScmMod")) + (define-on-demand module-link-color (make-scheme-style "ScmModLink")) + (define-on-demand block-color (make-scheme-style "ScmBlk")) + (define-on-demand highlighted-color (make-scheme-style "highlighted" #:tt? #f)) (define current-keyword-list (make-parameter null))