Browser-to-Racket
Update the browser collection to use Racket lang instead of mzscheme.
This commit is contained in:
Patrick Mahoney
Robby Findler
parent
9c4fcd4623
commit
2f2bbd09cc
|
|
@ -1,5 +1,5 @@
|
|||
(module browser-sig mzscheme
|
||||
(require mzlib/unit
|
||||
#lang racket
|
||||
(require racket/unit
|
||||
"private/sig.rkt")
|
||||
|
||||
(provide browser^)
|
||||
|
|
@ -7,4 +7,4 @@
|
|||
(define-signature browser^
|
||||
((open hyper^)
|
||||
(open html-export^)
|
||||
(open bullet-export^))))
|
||||
(open bullet-export^)))
|
||||
|
|
|
|||
|
|
@ -1,15 +1,16 @@
|
|||
(module browser-unit mzscheme
|
||||
(require mzlib/unit
|
||||
|
||||
#lang racket/base
|
||||
(require racket/unit
|
||||
mred/mred-sig
|
||||
setup/plt-installer-sig
|
||||
net/tcp-sig
|
||||
net/url-sig
|
||||
net/url-unit
|
||||
"browser-sig.rkt"
|
||||
"private/sig.rkt"
|
||||
"private/bullet.rkt"
|
||||
"private/html.rkt"
|
||||
"private/hyper.rkt")
|
||||
"private/hyper.rkt"
|
||||
"private/sig.rkt")
|
||||
|
||||
(provide browser@)
|
||||
|
||||
|
|
@ -31,8 +32,4 @@
|
|||
pre-browser@
|
||||
setup:plt-installer^
|
||||
mred^
|
||||
url^)))
|
||||
|
||||
|
||||
|
||||
|
||||
url^))
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
(module browser mzscheme
|
||||
(require mzlib/unit
|
||||
mred
|
||||
#lang racket
|
||||
(require racket/unit
|
||||
racket/gui
|
||||
mred/mred-sig
|
||||
setup/plt-installer-sig
|
||||
setup/plt-installer
|
||||
|
|
@ -12,4 +12,4 @@
|
|||
|
||||
(provide-signature-elements browser^)
|
||||
|
||||
(define-values/invoke-unit/infer browser@))
|
||||
(define-values/invoke-unit/infer browser@)
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ launching an external browser (such as Firefox).
|
|||
@declare-exporting[browser/browser browser]
|
||||
|
||||
The browser supports basic HTML commands, plus special Racket hyperlinks
|
||||
of the form @litchar{<A MZSCHEME=sexpr>...</A>}. When the user clicks
|
||||
of the form @litchar{<A RACKET=sexpr>...</A>}. When the user clicks
|
||||
on such a link, the string @racket[sexpr] is parsed as a Racket program
|
||||
and evaluated. Since @racket[sexpr] is likely to contain Racket
|
||||
strings, and since escape characters are difficult for people to read, a
|
||||
|
|
@ -44,7 +44,7 @@ strings, and since escape characters are difficult for people to read, a
|
|||
character before it is parsed. Thus,
|
||||
|
||||
@verbatim[#:indent 2]{
|
||||
<A MZSCHEME="|This goes nowhere.|">Nowhere</A>
|
||||
<A RACKET="|This goes nowhere.|">Nowhere</A>
|
||||
}
|
||||
|
||||
creates a ``Nowhere'' hyperlink, which executes the Racket program
|
||||
|
|
@ -59,15 +59,15 @@ clicks on ``Nowhere,'' the result is a new page that says ``This goes
|
|||
nowhere.''
|
||||
|
||||
The browser also treats comment forms containing
|
||||
@litchar{MZSCHEME=sexpr} specially. Whereas the
|
||||
@litchar{<A MZSCHEME=sexpr>...</A>} form executes the expression when
|
||||
the user clicks, the @litchar{MZSCHEME} expression in a comment is
|
||||
@litchar{RACKET=sexpr} specially. Whereas the
|
||||
@litchar{<A RACKET=sexpr>...</A>} form executes the expression when
|
||||
the user clicks, the @litchar{RACKET} expression in a comment is
|
||||
executed immediately during HTML rendering. If the result is a string,
|
||||
the comment is replaced in the input HTML stream with the content of the
|
||||
string. Thus,
|
||||
|
||||
@verbatim[#:indent 2]{
|
||||
<!-- MZSCHEME="(format |<B>Here</B>: ~a| (current-directory))" -->
|
||||
<!-- RACKET="(format |<B>Here</B>: ~a| (current-directory))" -->
|
||||
}
|
||||
|
||||
inserts the path of the current working directory into the containing
|
||||
|
|
@ -77,10 +77,10 @@ return values are ignored.
|
|||
|
||||
If the html file is being accessed as a @litchar{file:} url, the
|
||||
@racket[current-load-relative-directory] parameter is set to the
|
||||
directory during the evaluation of the mzscheme code (in both
|
||||
directory during the evaluation of the Racket code (in both
|
||||
examples). The Racket code is executed through @racket[eval].
|
||||
|
||||
The @litchar{MZSCHEME} forms are disabled unless the web page is a
|
||||
The @litchar{RACKET} forms are disabled unless the web page is a
|
||||
@litchar{file:} url that points into the @racket[doc] collection.
|
||||
|
||||
@defproc[(open-url [url (or/c url? string? input-port?)]) (is-a?/c hyper-frame%)]{
|
||||
|
|
@ -94,7 +94,7 @@ The @litchar{MZSCHEME} forms are disabled unless the web page is a
|
|||
}
|
||||
|
||||
@defboolparam[html-eval-ok ok?]{
|
||||
A parameter that determines whether @litchar{MZSCHEME=} tags are
|
||||
A parameter that determines whether @litchar{RACKET=} tags are
|
||||
evaluated.
|
||||
}
|
||||
|
||||
|
|
@ -145,7 +145,7 @@ The @litchar{MZSCHEME} forms are disabled unless the web page is a
|
|||
|
||||
@definterface[hyper-text<%> ()]{
|
||||
@defmethod[(url-allows-evalling? [url (or/c port? url?)]) boolean?]{
|
||||
Determines if @litchar{MZSCHEME} annotations are actually evaluated,
|
||||
Determines if @litchar{RACKET} annotations are actually evaluated,
|
||||
for a given url.
|
||||
}
|
||||
}
|
||||
|
|
@ -244,8 +244,8 @@ The @litchar{MZSCHEME} forms are disabled unless the web page is a
|
|||
}
|
||||
|
||||
@defmethod[(eval-racket-string [str string?]) any]{
|
||||
Called to handle the @litchar{<A MZSCHEME="expr">...</A>} tag and
|
||||
@litchar{<! MZSCHEME="expr">} comments (see above). Evaluates the
|
||||
Called to handle the @litchar{<A RACKET="expr">...</A>} tag and
|
||||
@litchar{<! RACKET="expr">} comments (see above). Evaluates the
|
||||
string; if the result is a string, it is opened as an HTML page.
|
||||
}
|
||||
|
||||
|
|
@ -559,11 +559,11 @@ The @litchar{MZSCHEME} forms are disabled unless the web page is a
|
|||
@defproc[(render-html-to-text [in input-port?]
|
||||
[dest (is-a? html-text<%>)]
|
||||
[load-img? any/c]
|
||||
[eval-mz? any/c])
|
||||
[eval-rkt? any/c])
|
||||
void?]{
|
||||
Reads HTML from @racket[in] and renders it to @racket[dest]. If
|
||||
@racket[load-img?] is @racket[#f], then images are rendered as Xed-out
|
||||
boxes. If @racket[eval-mz?] is @racket[#f], then @litchar{MZSCHEME}
|
||||
boxes. If @racket[eval-rkt?] is @racket[#f], then @litchar{RACKET}
|
||||
hyperlink expressions and comments are not evaluated.
|
||||
|
||||
Uses the style named @racket["Html Standard"] in the editor's
|
||||
|
|
|
|||
|
|
@ -1,3 +1,3 @@
|
|||
(module bullet-snip mzscheme
|
||||
#lang racket
|
||||
(require "private/bullet.rkt")
|
||||
(provide (rename bullet-snip-class snip-class)))
|
||||
(provide (rename-out (bullet-snip-class snip-class)))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket/base
|
||||
(require string-constants
|
||||
mred
|
||||
racket/gui
|
||||
racket/class
|
||||
racket/file
|
||||
racket/list
|
||||
|
|
|
|||
|
|
@ -1,14 +1,13 @@
|
|||
|
||||
(module htmltext mzscheme
|
||||
(require mzlib/unit
|
||||
mzlib/class
|
||||
#lang racket
|
||||
(require racket/unit
|
||||
racket/class
|
||||
"browser-sig.rkt"
|
||||
"private/sig.rkt"
|
||||
"private/html.rkt"
|
||||
"private/bullet.rkt"
|
||||
net/url
|
||||
net/url-sig
|
||||
mred
|
||||
racket/gui
|
||||
mred/mred-unit
|
||||
mred/mred-sig
|
||||
browser/external)
|
||||
|
|
@ -28,7 +27,7 @@
|
|||
add-link
|
||||
add-tag
|
||||
make-link-style
|
||||
add-scheme-callback
|
||||
add-racket-callback
|
||||
add-thunk-callback
|
||||
post-url))
|
||||
|
||||
|
|
@ -47,7 +46,7 @@
|
|||
(define/public (add-tag label pos) (void))
|
||||
(define/public (make-link-style pos endpos)
|
||||
(change-style url-delta pos endpos))
|
||||
(define/public (add-scheme-callback pos endpos scheme) (void))
|
||||
(define/public (add-racket-callback pos endpos racket) (void))
|
||||
(define/public (add-thunk-callback pos endpos thunk)
|
||||
(set-clickback pos endpos (lambda (e start-pos eou-pos)
|
||||
(thunk))))
|
||||
|
|
@ -73,5 +72,5 @@
|
|||
|
||||
(provide html-text<%>
|
||||
html-text-mixin
|
||||
render-html-to-text))
|
||||
render-html-to-text)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
#lang setup/infotab
|
||||
|
||||
(define tools (list (list "tool.rkt")))
|
||||
(define tool-names (list "Browser"))
|
||||
|
||||
(define drracket-tools (list (list "tool.rkt")))
|
||||
(define drracket-tool-names (list "Browser"))
|
||||
(define scribblings '(("browser.scrbl" () (gui-library))))
|
||||
|
|
|
|||
|
|
@ -1,3 +1,3 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
(require "browser.rkt")
|
||||
(provide (all-from-out "browser.rkt"))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme/unit
|
||||
#lang racket/unit
|
||||
|
||||
(require "sig.rkt")
|
||||
|
||||
|
|
@ -12,9 +12,9 @@
|
|||
(export (rename relative-btree^
|
||||
(create-btree make-btree)))
|
||||
|
||||
(define-struct btree (root) #:mutable)
|
||||
(struct btree (root) #:mutable)
|
||||
|
||||
(define-struct node (pos data parent left right color) #:mutable)
|
||||
(struct node (pos data parent left right color) #:mutable)
|
||||
|
||||
(define (adjust-offsets n new-child)
|
||||
(when new-child
|
||||
|
|
@ -66,7 +66,7 @@
|
|||
|
||||
|
||||
(define (insert before? n btree pos data)
|
||||
(let ([new (make-node pos data #f #f #f 'black)])
|
||||
(let ([new (node pos data #f #f #f 'black)])
|
||||
(if (not (btree-root btree))
|
||||
(set-btree-root! btree new)
|
||||
|
||||
|
|
@ -166,7 +166,7 @@
|
|||
(loop (node-right n) so-far so-far-pos npos)]))))))
|
||||
|
||||
(define (create-btree)
|
||||
(make-btree #f))
|
||||
(btree #f))
|
||||
|
||||
(define (btree-get btree pos)
|
||||
(let-values ([(n npos) (find-following-node btree pos)])
|
||||
|
|
|
|||
|
|
@ -1,13 +1,13 @@
|
|||
(module bullet mzscheme
|
||||
(require mred
|
||||
mzlib/class)
|
||||
#lang racket
|
||||
(require racket/gui
|
||||
racket/class)
|
||||
|
||||
(provide bullet-snip%
|
||||
get-bullet-width
|
||||
bullet-size
|
||||
bullet-snip-class)
|
||||
|
||||
(define snip-class-name "(lib \"bullet-snip.ss\" \"browser\")")
|
||||
(define snip-class-name "(lib \"bullet-snip.rkt\" \"browser\")")
|
||||
|
||||
(define bullet-size
|
||||
(make-parameter
|
||||
|
|
@ -90,5 +90,5 @@
|
|||
(super-new)
|
||||
(set-classname snip-class-name))))
|
||||
|
||||
(send (get-the-snip-class-list) add bullet-snip-class))
|
||||
(send (get-the-snip-class-list) add bullet-snip-class)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
(module entity-names mzscheme
|
||||
#lang racket
|
||||
(provide entity-name->integer)
|
||||
|
||||
(define table
|
||||
#cs#hasheq((nbsp . 160)
|
||||
#hasheq((nbsp . 160)
|
||||
(iexcl . 161)
|
||||
(cent . 162)
|
||||
(pound . 163)
|
||||
|
|
@ -256,6 +256,6 @@
|
|||
(euro . 8364)))
|
||||
|
||||
(define (entity-name->integer s)
|
||||
(hash-table-get table s (lambda () #f))))
|
||||
(hash-ref table s (lambda () #f)))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,13 +1,13 @@
|
|||
#lang scheme/unit
|
||||
#lang racket/unit
|
||||
|
||||
(require "sig.rkt"
|
||||
mred/mred-sig
|
||||
scheme/file
|
||||
mzlib/port
|
||||
racket/file
|
||||
racket/port
|
||||
net/url-sig
|
||||
(only-in html read-html-as-xml read-html-comments use-html-spec)
|
||||
(except-in xml read-comments)
|
||||
mzlib/class
|
||||
racket/class
|
||||
"bullet.rkt"
|
||||
"option-snip.rkt"
|
||||
"entity-names.rkt")
|
||||
|
|
@ -140,24 +140,24 @@
|
|||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; Hardwired Scheme colorization; should come from a .css file
|
||||
;; Hardwired Racket colorization; should come from a .css file
|
||||
;;
|
||||
|
||||
(define (make-scheme-color-delta col)
|
||||
(define (make-racket-color-delta col)
|
||||
(let ([d (make-object style-delta%)])
|
||||
(send d set-delta-foreground col)
|
||||
d))
|
||||
|
||||
(define scheme-code-delta (make-scheme-color-delta "brown"))
|
||||
(define scheme-code-delta/keyword
|
||||
(let ([d (make-scheme-color-delta (make-object color% #x99 0 0))])
|
||||
(define racket-code-delta (make-racket-color-delta "brown"))
|
||||
(define racket-code-delta/keyword
|
||||
(let ([d (make-racket-color-delta (make-object color% #x99 0 0))])
|
||||
(send d set-weight-on 'bold)
|
||||
d))
|
||||
(define scheme-code-delta/variable (make-scheme-color-delta "navy"))
|
||||
(define scheme-code-delta/global (make-scheme-color-delta "purple"))
|
||||
(define scheme-code-delta/selfeval (make-scheme-color-delta "forest green"))
|
||||
(define scheme-code-delta/comment (make-scheme-color-delta "cornflower blue"))
|
||||
(define navigation-delta (let ([d (make-scheme-color-delta "red")])
|
||||
(define racket-code-delta/variable (make-racket-color-delta "navy"))
|
||||
(define racket-code-delta/global (make-racket-color-delta "purple"))
|
||||
(define racket-code-delta/selfeval (make-racket-color-delta "forest green"))
|
||||
(define racket-code-delta/comment (make-racket-color-delta "cornflower blue"))
|
||||
(define navigation-delta (let ([d (make-racket-color-delta "red")])
|
||||
(send d set-style-on 'italic)
|
||||
d))
|
||||
|
||||
|
|
@ -166,13 +166,13 @@
|
|||
(define (lookup-class-delta class)
|
||||
(let ([class-path (cons class (current-style-class))])
|
||||
(cond
|
||||
[(sub-path? class-path '("scheme")) scheme-code-delta]
|
||||
[(sub-path? class-path '("keyword" "scheme")) scheme-code-delta/keyword]
|
||||
[(sub-path? class-path '("variable" "scheme")) scheme-code-delta/variable]
|
||||
[(sub-path? class-path '("global" "scheme")) scheme-code-delta/global]
|
||||
[(or (sub-path? class-path '("selfeval" "scheme"))
|
||||
(sub-path? class-path '("schemeresponse"))) scheme-code-delta/selfeval]
|
||||
[(sub-path? class-path '("comment" "scheme")) scheme-code-delta/comment]
|
||||
[(sub-path? class-path '("racket")) racket-code-delta]
|
||||
[(sub-path? class-path '("keyword" "racket")) racket-code-delta/keyword]
|
||||
[(sub-path? class-path '("variable" "racket")) racket-code-delta/variable]
|
||||
[(sub-path? class-path '("global" "racket")) racket-code-delta/global]
|
||||
[(or (sub-path? class-path '("selfeval" "racket"))
|
||||
(sub-path? class-path '("racketresponse"))) racket-code-delta/selfeval]
|
||||
[(sub-path? class-path '("comment" "racket")) racket-code-delta/comment]
|
||||
[(sub-path? class-path '("navigation")) navigation-delta]
|
||||
[else #f])))
|
||||
|
||||
|
|
@ -209,7 +209,7 @@
|
|||
|
||||
(define (get-bitmap-from-url url)
|
||||
(if (html-img-ok)
|
||||
(let ([tmp-filename (make-temporary-file "mredimg~a")])
|
||||
(let ([tmp-filename (make-temporary-file "rktguiimg~a")])
|
||||
(load-status #t "image" url)
|
||||
(call-with-output-file* tmp-filename
|
||||
(lambda (op)
|
||||
|
|
@ -331,7 +331,7 @@
|
|||
|
||||
;; parse-coords : string -> (listof number)
|
||||
;; separates out a bunch of comma separated numbers in a string
|
||||
;; into a list of scheme numbers
|
||||
;; into a list of racket numbers
|
||||
(define (parse-coords str)
|
||||
(let loop ([str str])
|
||||
(cond
|
||||
|
|
@ -369,13 +369,13 @@
|
|||
(let ([a (assq name (cadr e))])
|
||||
(and a (cadr a))))
|
||||
|
||||
(define get-mzscheme-arg
|
||||
(let ([get-mz (make-get-field "mzscheme")])
|
||||
(define get-racket-arg
|
||||
(let ([get-rkt (make-get-field "racket")])
|
||||
(lambda (str)
|
||||
(let ([v (get-mz str)])
|
||||
(and v (filter-mzscheme v))))))
|
||||
(let ([v (get-rkt str)])
|
||||
(and v (filter-racket v))))))
|
||||
|
||||
(define filter-mzscheme
|
||||
(define filter-racket
|
||||
(lambda (v)
|
||||
(regexp-replace* "[|]" v "\"")))
|
||||
|
||||
|
|
@ -475,12 +475,12 @@
|
|||
[(symbol? c) (values c #t)]
|
||||
[(number? c) (values c #t)]
|
||||
[(comment? c)
|
||||
(let ([code (get-mzscheme-arg (comment-text c))])
|
||||
(let ([code (get-racket-arg (comment-text c))])
|
||||
(if code
|
||||
(let ([s (with-handlers ([exn:fail?
|
||||
(lambda (exn)
|
||||
(format
|
||||
"<font color=\"red\">Error during <!-- MZSCHEME=... -->: <i>~a</i></font>"
|
||||
"<font color=\"red\">Error during <!-- RACKET=... -->: <i>~a</i></font>"
|
||||
(if (exn? exn)
|
||||
(exn-message exn)
|
||||
(format "~s" exn))))])
|
||||
|
|
@ -646,9 +646,9 @@
|
|||
(unescape str)))]
|
||||
[else #f])]
|
||||
[label (get-field s 'name)]
|
||||
[scheme (let ([v (get-field s 'mzscheme)])
|
||||
(and v (filter-mzscheme v)))])
|
||||
(values url-string label scheme))))]
|
||||
[racket (let ([v (get-field s 'racket)])
|
||||
(and v (filter-racket v)))])
|
||||
(values url-string label racket))))]
|
||||
|
||||
[parse-font
|
||||
(let ([face-regexp (regexp "([^,]*), *(.*)")])
|
||||
|
|
@ -908,7 +908,7 @@
|
|||
(delete pos (current-pos)))
|
||||
(values void forced-lines)]
|
||||
[(a)
|
||||
(let-values ([(url-string label scheme) (parse-href e)])
|
||||
(let-values ([(url-string label racket) (parse-href e)])
|
||||
(let* ([style (get-field e 'style)]
|
||||
[pos (current-pos)])
|
||||
(let-values ([(r rfl) (rest)])
|
||||
|
|
@ -929,8 +929,8 @@
|
|||
[label
|
||||
(send a-text add-tag label pos)
|
||||
(values r rfl)]
|
||||
[scheme
|
||||
(send a-text add-scheme-callback pos end-pos scheme)
|
||||
[racket
|
||||
(send a-text add-racket-callback pos end-pos racket)
|
||||
(values
|
||||
(lambda ()
|
||||
(when (or (not style)
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#|
|
||||
A test case:
|
||||
|
||||
(module tmp mzscheme
|
||||
(require mzlib/class mred browser framework)
|
||||
#lang racket
|
||||
(require racket/gui browser framework)
|
||||
|
||||
(define f%
|
||||
(frame:status-line-mixin
|
||||
|
|
@ -22,15 +22,16 @@ A test case:
|
|||
;; The starting URL:
|
||||
"http://www.htdp.org/";
|
||||
;; #f means not a relative URL:
|
||||
#f))
|
||||
#f)
|
||||
|#
|
||||
|
||||
#lang scheme/unit
|
||||
#lang racket/unit
|
||||
|
||||
(require mzlib/class
|
||||
(require racket/class
|
||||
(only-in racket/list last-pair)
|
||||
"sig.rkt"
|
||||
scheme/path
|
||||
scheme/file
|
||||
racket/path
|
||||
racket/file
|
||||
net/url-sig
|
||||
net/url-structs
|
||||
net/head
|
||||
|
|
@ -39,7 +40,6 @@ A test case:
|
|||
string-constants
|
||||
setup/plt-installer-sig)
|
||||
|
||||
|
||||
(import html^
|
||||
mred^
|
||||
setup:plt-installer^
|
||||
|
|
@ -47,20 +47,15 @@ A test case:
|
|||
(export hyper^)
|
||||
(init-depend mred^)
|
||||
|
||||
(define (last-pair l)
|
||||
(if (null? (cdr l))
|
||||
l
|
||||
(last-pair (cdr l))))
|
||||
|
||||
(define-struct (exn:file-saved-instead exn) (pathname))
|
||||
(define-struct (exn:cancelled exn) ())
|
||||
(define-struct (exn:tcp-problem exn) ())
|
||||
(struct exn:file-saved-instead exn (pathname))
|
||||
(struct exn:cancelled exn ())
|
||||
(struct exn:tcp-problem exn ())
|
||||
|
||||
(define history-limit 20)
|
||||
|
||||
(define-struct hyperlink (anchor-start anchor-end url-string))
|
||||
(struct hyperlink (anchor-start anchor-end url-string))
|
||||
|
||||
(define-struct hypertag (name position))
|
||||
(struct hypertag (name position))
|
||||
|
||||
(define (same-page-url? a b)
|
||||
(or (eq? a b)
|
||||
|
|
@ -104,7 +99,7 @@ A test case:
|
|||
(equal? "file" (url-scheme url)))
|
||||
(with-handlers ([exn:fail:filesystem? (lambda (x) #f)])
|
||||
(path-below?
|
||||
(normal-case-path (normalize-path (build-path (collection-path "mzlib")
|
||||
(normal-case-path (normalize-path (build-path (collection-path "racket")
|
||||
'up
|
||||
'up)))
|
||||
(normal-case-path (normalize-path (apply build-path
|
||||
|
|
@ -115,7 +110,7 @@ A test case:
|
|||
(define title #f)
|
||||
(define htmling? #f)
|
||||
(define redirection #f)
|
||||
(define hypertags-list (list (make-hypertag "top" 0)))
|
||||
(define hypertags-list (list (hypertag "top" 0)))
|
||||
(define hyper-delta (make-object style-delta% 'change-underline #t))
|
||||
(let ([mult (send hyper-delta get-foreground-mult)]
|
||||
[add (send hyper-delta get-foreground-add)])
|
||||
|
|
@ -162,7 +157,7 @@ A test case:
|
|||
(when (string=? name (hypertag-name tag))
|
||||
(remove-tag name)))
|
||||
hypertags-list)
|
||||
(let ([new-tag (make-hypertag name pos)])
|
||||
(let ([new-tag (hypertag name pos)])
|
||||
(set! hypertags-list
|
||||
(let insert-loop ([tags-left hypertags-list])
|
||||
(cond [(null? tags-left)(cons new-tag '())]
|
||||
|
|
@ -184,30 +179,30 @@ A test case:
|
|||
(filter (lambda (x) (not (string=? name (hypertag-name x))))
|
||||
hypertags-list)))
|
||||
(define/public (add-link start end url-string)
|
||||
(let* ([new-link (make-hyperlink start end url-string)])
|
||||
(let* ([new-link (hyperlink start end url-string)])
|
||||
(set-clickback start end
|
||||
(lambda (x y z)
|
||||
(post-url url-string)))))
|
||||
|
||||
;; remember the directory when the callback is added (during parsing)
|
||||
;; and restore it during the evaluation of the callback.
|
||||
(define/public (add-scheme-callback start end scheme-string)
|
||||
(define/public (add-racket-callback start end racket-string)
|
||||
(let ([dir (current-load-relative-directory)])
|
||||
(set-clickback
|
||||
start end
|
||||
(lambda (edit start end)
|
||||
(if (url-allows-evaling? url)
|
||||
(parameterize ([current-load-relative-directory dir])
|
||||
(eval-scheme-string scheme-string))
|
||||
(eval-racket-string racket-string))
|
||||
(message-box (string-constant help-desk)
|
||||
"<A MZSCHEME= ...> disabled"))))))
|
||||
"<A RACKET= ...> disabled"))))))
|
||||
(define/public (add-thunk-callback start end thunk)
|
||||
(set-clickback
|
||||
start end
|
||||
(lambda (edit start end)
|
||||
(thunk))))
|
||||
|
||||
(define/public (eval-scheme-string s)
|
||||
(define/public (eval-racket-string s)
|
||||
(let ([v
|
||||
(dynamic-wind
|
||||
begin-busy-cursor
|
||||
|
|
@ -388,13 +383,13 @@ A test case:
|
|||
(send d center)
|
||||
(send d show #t)
|
||||
(unless (or d? i?)
|
||||
(raise (make-exn:cancelled
|
||||
(raise (exn:cancelled
|
||||
"Package Cancelled"
|
||||
(current-continuation-marks))))
|
||||
i?))]
|
||||
[tmp-plt-filename
|
||||
(if install?
|
||||
(make-temporary-file "tmp~a.plt")
|
||||
(make-temporary-file "tmp~a.rkt")
|
||||
(put-file
|
||||
(if size
|
||||
(format
|
||||
|
|
@ -449,7 +444,7 @@ A test case:
|
|||
(queue-callback (lambda () (semaphore-post wait-to-start)))
|
||||
(send d show #t)
|
||||
(when exn
|
||||
(raise (make-exn:tcp-problem (exn-message exn) (current-continuation-marks)))))
|
||||
(raise (exn:tcp-problem (exn-message exn) (current-continuation-marks)))))
|
||||
(let ([sema (make-semaphore 0)])
|
||||
(when (and tmp-plt-filename install?)
|
||||
(run-installer tmp-plt-filename
|
||||
|
|
@ -458,13 +453,13 @@ A test case:
|
|||
(yield sema))))
|
||||
(raise
|
||||
(if tmp-plt-filename
|
||||
(make-exn:file-saved-instead
|
||||
(exn:file-saved-instead
|
||||
(if install?
|
||||
(string-constant package-was-installed)
|
||||
(string-constant download-was-saved))
|
||||
(current-continuation-marks)
|
||||
tmp-plt-filename)
|
||||
(make-exn:cancelled "The download was cancelled."
|
||||
(exn:cancelled "The download was cancelled."
|
||||
(current-continuation-marks)))))]
|
||||
[(or (and (url? url)
|
||||
(not (null? (url-path url)))
|
||||
|
|
@ -576,9 +571,9 @@ A test case:
|
|||
;; build-html-error-message : exn -> string[html]
|
||||
(define ((build-html-error-message str) exn)
|
||||
(string-append
|
||||
"<html><head><title>Error Evaluating Scheme</title></head>"
|
||||
"<html><head><title>Error Evaluating Racket</title></head>"
|
||||
"<body>"
|
||||
"<h2>Error Evaluating Scheme Code</h2>"
|
||||
"<h2>Error Evaluating Racket Code</h2>"
|
||||
(format "<pre>\n~a\n</pre>" str)
|
||||
"<p><p>"
|
||||
(format "<font color=\"red\">~a</font>"
|
||||
|
|
@ -743,7 +738,7 @@ A test case:
|
|||
(set-page (list e (or tag-pos 0) (send e last-position)) #t)
|
||||
(when tag-pos (send e set-position tag-pos)))]
|
||||
[(exn? result)
|
||||
(message-box (string-constant drscheme)
|
||||
(message-box (string-constant drracket)
|
||||
(exn-message result)
|
||||
tlw)]
|
||||
[else (void)]))))))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,5 @@
|
|||
(module option-snip mzscheme
|
||||
(require mred
|
||||
mzlib/class
|
||||
mzlib/string)
|
||||
#lang racket
|
||||
(require racket/gui)
|
||||
|
||||
(provide option-snip%
|
||||
checkbox-snip%)
|
||||
|
|
@ -198,4 +196,4 @@
|
|||
|
||||
(super-instantiate ())
|
||||
(set-flags (cons 'handles-events (get-flags)))
|
||||
(set-count 1))))
|
||||
(set-count 1)))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
(module sig scheme/base
|
||||
(require scheme/unit)
|
||||
#lang racket
|
||||
(require racket/unit)
|
||||
|
||||
(provide relative-btree^
|
||||
bullet-export^
|
||||
|
|
@ -21,8 +21,8 @@
|
|||
|
||||
(define-signature hyper^
|
||||
(open-url
|
||||
(struct exn:file-saved-instead (pathname))
|
||||
(struct exn:cancelled ())
|
||||
(struct exn:file-saved-instead (pathname) #:omit-constructor)
|
||||
(struct exn:cancelled () #:omit-constructor)
|
||||
|
||||
hyper-text<%>
|
||||
hyper-text-mixin
|
||||
|
|
@ -54,4 +54,4 @@
|
|||
btree-shift!
|
||||
|
||||
btree-for-each
|
||||
btree-map)))
|
||||
btree-map))
|
||||
|
|
|
|||
|
|
@ -1,15 +1,16 @@
|
|||
(module tool mzscheme
|
||||
(require browser/external
|
||||
mzlib/unit
|
||||
drscheme/tool)
|
||||
#lang racket
|
||||
(require (only-in "external.rkt" install-help-browser-preference-panel)
|
||||
racket/unit
|
||||
drracket/tool)
|
||||
(provide tool@)
|
||||
|
||||
;; to add a preference pannel to drscheme that sets the browser preference
|
||||
;; to add a preference pannel to drracket that sets the browser preference
|
||||
(define tool@
|
||||
(unit
|
||||
(import drscheme:tool^)
|
||||
(export drscheme:tool-exports^)
|
||||
(define phase1 void)
|
||||
(define phase2 void)
|
||||
(import drracket:tool^)
|
||||
(export drracket:tool-exports^)
|
||||
|
||||
(install-help-browser-preference-panel))))
|
||||
(define (phase1) (void))
|
||||
(define (phase2) (void))
|
||||
|
||||
(install-help-browser-preference-panel)))
|
||||
|
|
@ -106,6 +106,7 @@ please adhere to these guidelines:
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "Ok")
|
||||
(cancel "Fortryd")
|
||||
(abort "Afbryd")
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "OK")
|
||||
(cancel "Annuleren")
|
||||
(untitled "Naamloos")
|
||||
|
|
|
|||
|
|
@ -106,6 +106,7 @@ please adhere to these guidelines:
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "OK")
|
||||
(cancel "Cancel")
|
||||
(abort "Abort")
|
||||
|
|
|
|||
|
|
@ -106,6 +106,7 @@
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "OK")
|
||||
(cancel "Annuler")
|
||||
(abort "Abandonner")
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "OK")
|
||||
;; We can't use "Abbrechen" here because that's much closer in
|
||||
;; meaning to "abort", and it appears in dialogs saying "Quit?" "OK"
|
||||
|
|
|
|||
|
|
@ -106,6 +106,7 @@ please adhere to these guidelines:
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "OK")
|
||||
(cancel "キャンセル")
|
||||
(abort "中止")
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "확인")
|
||||
(cancel "취소")
|
||||
(abort "중단")
|
||||
|
|
|
|||
|
|
@ -106,6 +106,7 @@ please adhere to these guidelines:
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "OK")
|
||||
(cancel "Cancelar")
|
||||
(abort "Abortar")
|
||||
|
|
|
|||
|
|
@ -106,6 +106,7 @@ please adhere to these guidelines:
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "OK")
|
||||
(cancel "Отмена")
|
||||
(abort "Отмена")
|
||||
|
|
|
|||
|
|
@ -33,6 +33,7 @@
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "确定")
|
||||
(cancel "取消")
|
||||
(abort "中止")
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "OK")
|
||||
(cancel "Cancelar")
|
||||
(abort "Abortar")
|
||||
|
|
|
|||
|
|
@ -16,6 +16,8 @@
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
|
||||
(ok "確定")
|
||||
(cancel "取消")
|
||||
(abort "中止")
|
||||
|
|
|
|||
|
|
@ -106,6 +106,7 @@ please adhere to these guidelines:
|
|||
;;; general purpose (DrRacket is hereby a word in every language, by decree of Robby :)
|
||||
(plt "PLT")
|
||||
(drscheme "DrRacket")
|
||||
(drracket "DrRacket")
|
||||
(ok "OK")
|
||||
(cancel "Скасувати")
|
||||
(abort "Скасувати")
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user