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
This commit is contained in:
Matthew Flatt 2009-09-24 14:54:15 +00:00
parent 803add9f4f
commit c5f2e45cf0
6 changed files with 46 additions and 30 deletions

View File

@ -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

View File

@ -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)

View File

@ -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"))

View File

@ -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 "#<void>"))
(define undefined-const
(define-on-demand undefined-const
(schemeresultfont "#<undefined>"))
(define (link url

View File

@ -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)))))

View File

@ -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))