suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make the drracket/tool-lib library

Browse Source 
exports and drracket:tool^ be in sync

This doesn't quite do the whole job
because something seems to get names
confused when structs and signatures
team up. This is a small example that, I
believe, demonstrates the problem:

(require racket/unit)

(struct p:s ())
(define p:struct:s struct:p:s)

(define-signature s1^
  ((struct s ())))

(define-signature s2^
  ((open (prefix p: s1^))))

(define-values/invoke-unit
  (unit (import s2^) (export))
  (import s2^)
  (export))
This commit is contained in:
Robby Findler 2013-09-20 14:37:11 -05:00
parent 8b99d87e95
commit f6267ad661
22 changed files with 636 additions and 487 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
pkgs/drracket-pkgs/drracket-plugin-lib/drracket/private/drsig.rkt
View File

@ -6,6 +6,7 @@
drracket:module-language^
drracket:module-language/int^
drracket:module-language-tools^
drracket:module-language-tools/int^
drracket:get-collection^
drracket:main^
drracket:init^
@ -15,18 +16,23 @@
drracket:tools-drs^
drracket:get/extend^
drracket:unit^
drracket:unit/int^
drracket:frame^
drracket:frame/int^
drracket:program^
drracket:text^
drracket:rep^
drracket:rep/int^
drracket:app^
drracket:draw-arrow^
drracket:help-desk^
drracket:language^
drracket:language/int^
drracket:multi-file-search^
drracket:module-overview^
drracket:font^
drracket:modes^
drracket:modes/int^
drracket:tracing^
drracket:tool-exports^
drracket:tool^
@ -40,10 +46,10 @@
(define-signature drracket:modes^ extends drracket:modes-cm^
(add-mode
get-modes
add-initial-modes
make-mode
(struct mode (name surrogate repl-submit matches-language)
#:omit-constructor)))
#:omit-constructor)))
(define-signature drracket:modes/int^ extends drracket:modes^
(add-initial-modes))
(define-signature drracket:font-cm^
())
@ -114,10 +120,9 @@
(define-signature drracket:module-language-tools^ extends drracket:module-language-tools-cm^
(add-opt-out-toolbar-button
add-online-expansion-handler
register-online-expansion-pref
;; the below should be hidden from tools
get-online-expansion-pref-funcs
register-online-expansion-pref))
(define-signature drracket:module-language-tools/int^ extends drracket:module-language-tools^
(get-online-expansion-pref-funcs
(struct online-expansion-handler (mod-path id local-handler))
get-online-expansion-handlers
no-more-online-expansion-handlers))
@ -155,8 +160,7 @@
make-language-settings
get-settings-preferences-symbol
language-dialog
fill-language-dialog
language-allows-executable-creation?))
fill-language-dialog))
(define-signature drracket:language-configuration/internal^ extends drracket:language-configuration^
(add-info-specified-languages
@ -165,7 +169,8 @@
get-all-scheme-manual-keywords
get-all-manual-keywords
add-built-in-languages
not-a-language-language<%>))
not-a-language-language<%>
language-allows-executable-creation?))
(define-signature drracket:tools-cm^
())
@ -212,16 +217,19 @@
find-symbol
get-program-editor-mixin
add-to-program-editor-mixin
forget-saved-bug-report
record-saved-bug-report
(struct teachpack-callbacks (get-names remove add))
(struct teachpack-callbacks (get-names add remove remove-all))
make-teachpack-callbacks
add-search-help-desk-menu-item))
(define-signature drracket:unit/int^ extends drracket:unit^
(forget-saved-bug-report
record-saved-bug-report))
(define-signature drracket:frame-cm^
(mixin
basics-mixin))
(define-signature drracket:frame^ extends drracket:frame-cm^
())
(define-signature drracket:frame/int^ extends drracket:frame^
(create-root-menubar
add-keybindings-item
planet-spec?))
@ -262,10 +270,11 @@
current-value-port
after-expression
get-drs-bindings-keymap
error-delta
get-error-delta
get-welcome-delta
get-dark-green-delta
drs-autocomplete-mixin))
get-dark-green-delta))
(define-signature drracket:rep/int^ extends drracket:rep^
(drs-autocomplete-mixin))
(define-signature drracket:app-cm^
())
@ -284,8 +293,7 @@
())
(define-signature drracket:help-desk^ extends drracket:help-desk-cm^
(help-desk
goto-plt-license
get-docs))
goto-plt-license))
(define-signature drracket:language-cm^
(language<%>
@ -320,18 +328,19 @@
annotations))
simple-settings->vector
simple-module-based-language-config-panel
simple-module-based-language-convert-value
setup-printing-parameters
make-setup-printing-parameters
add-snip-value
setup-setup-values
register-capability
capability-registered?
get-capability-default
get-capability-contract))
(define-signature drracket:language/int^ extends drracket:language^
(simple-module-based-language-config-panel
setup-setup-values))
(define-signature drracket:multi-file-search-cm^
())

27
pkgs/drracket-pkgs/drracket-test/tests/drracket/tool-lib-and-sig.rkt Normal file
View File

@ -0,0 +1,27 @@
#lang racket/base
#|
This file will fail to compile if
drracket/tool-lib and the contents of
drracket:tool^ get out of sync.
Running it will open up a DrRacket (not
something we need to do for this test).
|#
(module just-compile-me racket/base
(require drracket/tool
drracket/private/drsig
drracket/tool-lib
racket/unit)
(define-values/invoke-unit
(unit
(import drracket:tool^)
(export drracket:tool-exports^)
(define phase1 void)
(define phase2 void))
(import drracket:tool^)
(export drracket:tool-exports^)))

2
pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt
View File

@ -42,7 +42,7 @@ profile todo:
(define-unit debug@
(import [prefix drracket:rep: drracket:rep^]
[prefix drracket:frame: drracket:frame^]
[prefix drracket:unit: drracket:unit^]
[prefix drracket:unit: drracket:unit/int^]
[prefix drracket:language: drracket:language^]
[prefix drracket:language-configuration: drracket:language-configuration/internal^]
[prefix drracket:init: drracket:init^]

1
pkgs/drracket-pkgs/drracket/drracket/private/eval.rkt
View File

@ -7,6 +7,7 @@
syntax/toplevel
framework
"eval-helpers.rkt"
"local-member-names.rkt"
drracket/private/drsig)
;; to ensure this guy is loaded (and the snipclass installed)

4
pkgs/drracket-pkgs/drracket/drracket/private/frame.rkt
View File

@ -38,13 +38,13 @@
(submod "." install-pkg))
(provide frame@)
(define-unit frame@
(import [prefix drracket:unit: drracket:unit^]
(import [prefix drracket:unit: drracket:unit/int^]
[prefix drracket:app: drracket:app^]
[prefix help: drracket:help-desk^]
[prefix drracket:multi-file-search: drracket:multi-file-search^]
[prefix drracket:init: drracket:init^]
[prefix drracket: drracket:interface^])
(export (rename drracket:frame^
(export (rename drracket:frame/int^
[-mixin mixin]))
(define last-keybindings-planet-attempt "")

6
pkgs/drracket-pkgs/drracket/drracket/private/help-desk.rkt
View File

@ -8,7 +8,8 @@
setup/dirs
help/search
help/private/buginfo
drracket/private/drsig)
drracket/private/drsig
"local-member-names.rkt")
(import [prefix drracket:frame: drracket:frame^]
[prefix drracket:language-configuration: drracket:language-configuration/internal^]
@ -88,6 +89,3 @@
(define (help-desk [key #f] [context #f])
(if key (perform-search key context) (send-main-page)))
;; here for legacy code that should be removed
(define (get-docs) '())

52
pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt
View File

@ -1,25 +1,26 @@
#lang racket/base
(require (prefix-in : mred/mred) ;; ensure that this module is always loaded since it is shared below for pretty big
racket/unit
mrlib/hierlist
racket/class
racket/contract
racket/string
racket/list
racket/gui/base
drracket/private/drsig
"tooltip.rkt"
string-constants
framework
setup/getinfo
setup/xref
scribble/xref
scribble/tag
net/url
syntax/toplevel
browser/external
(only-in mzlib/struct make-->vector))
racket/unit
mrlib/hierlist
racket/class
racket/contract
racket/string
racket/list
racket/gui/base
drracket/private/drsig
"tooltip.rkt"
"local-member-names.rkt"
string-constants
framework
setup/getinfo
setup/xref
scribble/xref
scribble/tag
net/url
syntax/toplevel
browser/external
(only-in mzlib/struct make-->vector))
(define original-output (current-output-port))
(define (oprintf . args) (apply fprintf original-output args))
@ -66,6 +67,13 @@
[prefix drracket: drracket:interface^])
(export drracket:language-configuration/internal^)
(define struct:language-settings struct:drracket:language-configuration:language-settings)
(define language-settings? drracket:language-configuration:language-settings?)
(define language-settings-language drracket:language-configuration:language-settings-language)
(define language-settings-settings drracket:language-configuration:language-settings-settings)
(define make-language-settings drracket:language-configuration:language-settings)
(define language-settings make-language-settings)
;; settings-preferences-symbol : symbol
;; this pref used to depend on `version', but no longer does.
(define settings-preferences-symbol 'drracket:language-settings)
@ -148,8 +156,6 @@
(list-ref (get-languages) 0))])
(language-settings lang (send lang default-settings))))
;; type language-settings = (language-settings (instanceof language<%>) settings)
(define-struct language-settings (language settings))
;
@ -2040,7 +2046,7 @@
(define (not-a-language-extra-mixin %)
(class* % (not-a-language-language<%>)
(define/override (get-style-delta) drracket:rep:error-delta)
(define/override (get-style-delta) (drracket:rep:get-error-delta))
(define/override (first-opened)
(not-a-language-message)

43
pkgs/drracket-pkgs/drracket/drracket/private/language.rkt
View File

@ -27,6 +27,7 @@
compiler/bundle-dist
(prefix-in file: file/convertible)
"rep.rkt"
"local-member-names.rkt"
(prefix-in pict-snip: "pict-snip.rkt"))
(import [prefix drracket:debug: drracket:debug^]
@ -34,15 +35,19 @@
[prefix drracket:rep: drracket:rep^]
[prefix drracket:init: drracket:init^]
[prefix drracket:help-desk: drracket:help-desk^])
(export drracket:language^)
(export drracket:language/int^)
(define original-output-port (current-output-port))
(define (oprintf . args) (apply fprintf original-output-port args))
(define-struct text/pos (text start end))
;; text/pos = (make-text/pos (instanceof text% number number))
;; this represents a portion of a text to be processed.
(define text/pos-text drracket:language:text/pos-text)
(define text/pos-start drracket:language:text/pos-start)
(define text/pos-end drracket:language:text/pos-end)
(define make-text/pos make-drracket:language:text/pos)
(define text/pos? drracket:language:text/pos?)
(define struct:text/pos struct:drracket:language:text/pos)
(define text/pos make-text/pos)
(define language<%>
(interface ()
marshall-settings
@ -191,20 +196,18 @@
(simple-module-based-language-render-value/format value settings port 'infinity))
(super-new)))
;; settings for a simple module based language
(define-struct simple-settings (case-sensitive
printing-style
fraction-style
show-sharing
insert-newlines
annotations))
;; case-sensitive : boolean
;; printing-style : (union 'print 'write 'trad-write 'constructor 'quasiquote)
;; fraction-style : (union 'mixed-fraction 'mixed-fraction-e 'repeating-decimal 'repeating-decimal-e)
;; show-sharing : boolean
;; insert-newlines : boolean
;; annotations : (union 'none 'debug 'debug/profile 'test-coverage)
(define simple-settings->vector (make-->vector simple-settings))
(define simple-settings-case-sensitive drracket:language:simple-settings-case-sensitive)
(define simple-settings-fraction-style drracket:language:simple-settings-fraction-style)
(define simple-settings-show-sharing drracket:language:simple-settings-show-sharing)
(define simple-settings-insert-newlines drracket:language:simple-settings-insert-newlines)
(define simple-settings-annotations drracket:language:simple-settings-annotations)
(define simple-settings-printing-style drracket:language:simple-settings-printing-style)
(define struct:simple-settings struct:drracket:language:simple-settings)
(define simple-settings? drracket:language:simple-settings?)
(define make-simple-settings make-drracket:language:simple-settings)
(define simple-settings make-simple-settings)
(define simple-settings->vector (make-->vector drracket:language:simple-settings))
;; simple-module-based-language-config-panel :
;; parent [#:case-sensitive (union #f #t '?)]

2
pkgs/drracket-pkgs/drracket/drracket/private/link.rkt
View File

@ -25,7 +25,7 @@
"module-language-tools.rkt"
"interface.rkt")
(provide drracket@)
(provide drracket@ drscheme/drracket:tool^)
(define-compound-unit/infer drracket-unit@
(import)

47
pkgs/drracket-pkgs/drracket/drracket/private/local-member-names.rkt
View File

@ -1,8 +1,13 @@
#lang racket/base
(require racket/class)
(provide (all-defined-out))
(define-local-member-name
(define-syntax-rule
(define/provide-local-member-name x ...)
(begin
(define-local-member-name x ...)
(provide x ...)))
(define/provide-local-member-name
get-visible-defs
set-visible-defs
set-focus-d/i
@ -11,29 +16,27 @@
insert-auto-text)
;; from module-language-tools.rkt
(define-local-member-name
(define/provide-local-member-name
when-initialized
;move-to-new-language
get-in-module-language?)
;; for keybindings (otherwise private)
(define-local-member-name
(define/provide-local-member-name
jump-to-previous-error-loc
jump-to-next-error-loc)
;; defined in module-language.rkt
(define-local-member-name
(define/provide-local-member-name
set-lang-wants-big-defs/ints-labels?)
;; used by the test suite to tell when the
;; online check syntax has finished
(define-local-member-name
(define/provide-local-member-name
get-online-expansion-colors)
;; used by the module language
(define-local-member-name
;; used by the module language
(define/provide-local-member-name
frame-show-bkg-running
set-bottom-bar-most-recent-jumped-to-loc
set-expand-error/status
@ -49,4 +52,26 @@
set-oc-status
set-dep-paths
set-dirty-if-dep)
set-dirty-if-dep)
(provide (struct-out drracket:language-configuration:language-settings))
;; type language-settings = (language-settings (instanceof language<%>) settings)
(define-struct drracket:language-configuration:language-settings (language settings))
(provide (struct-out drracket:unit:teachpack-callbacks))
(define-struct drracket:unit:teachpack-callbacks (get-names add remove remove-all))
(provide (struct-out drracket:language:simple-settings))
(define-struct drracket:language:simple-settings (case-sensitive
printing-style
fraction-style
show-sharing
insert-newlines
annotations))
(provide (struct-out drracket:language:text/pos))
(define-struct drracket:language:text/pos (text start end))
(provide (struct-out drracket:modes:mode))
(struct drracket:modes:mode (name surrogate repl-submit matches-language))

5
pkgs/drracket-pkgs/drracket/drracket/private/main.rkt
View File

@ -6,6 +6,7 @@
racket/pretty
drracket/private/drsig
"frame-icon.rkt"
"local-member-names.rkt"
mred
framework
racket/list
@ -29,9 +30,9 @@
[prefix drracket:module-language: drracket:module-language/int^]
[prefix drracket:tools: drracket:tools^]
[prefix drracket:debug: drracket:debug^]
[prefix drracket:frame: drracket:frame^]
[prefix drracket:frame: drracket:frame/int^]
[prefix drracket:font: drracket:font^]
[prefix drracket:modes: drracket:modes^]
[prefix drracket:modes: drracket:modes/int^]
[prefix drracket:help-desk: drracket:help-desk^]
[prefix drracket:multi-file-search: drracket:multi-file-search^])
(export)

22
pkgs/drracket-pkgs/drracket/drracket/private/modes.rkt
View File

@ -4,21 +4,29 @@
racket/list
framework
racket/gui/base
drracket/private/drsig)
drracket/private/drsig
"local-member-names.rkt")
(import [prefix drracket:module-language: drracket:module-language/int^])
(export drracket:modes^)
(export drracket:modes/int^)
(define mode? drracket:modes:mode?)
(define mode-name drracket:modes:mode-name)
(define mode-surrogate drracket:modes:mode-surrogate)
(define mode-repl-submit drracket:modes:mode-repl-submit)
(define mode-matches-language drracket:modes:mode-matches-language)
(define struct:mode struct:drracket:modes:mode)
(define-struct mode (name surrogate repl-submit matches-language))
(define modes (list))
(define (get-modes) modes)
(define (add-mode name surrogate repl-submit matches-language)
(let ([new-mode (make-mode name
surrogate
repl-submit
matches-language)])
(let ([new-mode (drracket:modes:mode name
surrogate
repl-submit
matches-language)])
(set! modes (cons new-mode modes))
new-mode))

2
pkgs/drracket-pkgs/drracket/drracket/private/module-language-tools.rkt
View File

@ -20,7 +20,7 @@
[prefix drracket:language: drracket:language^]
[prefix drracket:language-configuration: drracket:language-configuration^]
[prefix drracket: drracket:interface^])
(export drracket:module-language-tools^)
(export drracket:module-language-tools/int^)
(define-struct opt-out-toolbar-button (make-button id number) #:transparent)
(define opt-out-toolbar-buttons '())

4
pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt
View File

@ -85,11 +85,11 @@
(define-unit module-language@
(import [prefix drracket:language-configuration: drracket:language-configuration/internal^]
[prefix drracket:language: drracket:language^]
[prefix drracket:language: drracket:language/int^]
[prefix drracket:unit: drracket:unit^]
[prefix drracket:rep: drracket:rep^]
[prefix drracket:init: drracket:init^]
[prefix drracket:module-language-tools: drracket:module-language-tools^]
[prefix drracket:module-language-tools: drracket:module-language-tools/int^]
[prefix drracket: drracket:interface^])
(export drracket:module-language/int^)

5
pkgs/drracket-pkgs/drracket/drracket/private/rep.rkt
View File

@ -49,7 +49,7 @@ TODO
(define-unit rep@
(import [prefix drracket:init: drracket:init^]
[prefix drracket:language-configuration: drracket:language-configuration/internal^]
[prefix drracket:language: drracket:language^]
[prefix drracket:language: drracket:language/int^]
[prefix drracket:app: drracket:app^]
[prefix drracket:frame: drracket:frame^]
[prefix drracket:unit: drracket:unit^]
@ -59,7 +59,7 @@ TODO
[prefix drracket:eval: drracket:eval^]
[prefix drracket:module-language: drracket:module-language/int^]
[prefix drracket: drracket:interface^])
(export (rename drracket:rep^
(export (rename drracket:rep/int^
[-text% text%]
[-text<%> text<%>]))
@ -276,6 +276,7 @@ TODO
'change-style
'italic))
(send error-delta set-delta-foreground (make-object color% 255 0 0))
(define (get-error-delta) error-delta)
(send result-delta set-delta-foreground (make-object color% 0 0 175))
(send output-delta set-delta-foreground (make-object color% 150 0 150))

64
pkgs/drracket-pkgs/drracket/drracket/private/tools-drs.rkt
View File

@ -2,7 +2,8 @@
#|
This file sets up the right lexical environment to invoke the tools that want to use the drscheme: names.
This file sets up the right lexical environment to
invoke the tools that want to use the drscheme: names.
|#
@ -10,18 +11,17 @@ This file sets up the right lexical environment to invoke the tools that want to
racket/list
racket/runtime-path
racket/contract
racket/struct-info
setup/getinfo
mred
framework
framework/splash
drracket/private/drsig
"language-object-contract.rkt"
"wrap-tool-inputs.rkt"
mrlib/switchable-button
string-constants)
(require (for-syntax racket/base racket/match
compiler/cm-accomplice
syntax/modread))
string-constants
net/url)
(import [prefix drscheme:frame: drracket:frame^]
[prefix drscheme:unit: drracket:unit^]
@ -40,55 +40,14 @@ This file sets up the right lexical environment to invoke the tools that want to
[prefix drscheme: drracket:interface^])
(export drracket:tools-drs^)
(define-syntax (wrap-tool-inputs stx)
(syntax-case stx ()
[(_ body tool-name)
(let ()
(define tool-lib-src (collection-file-path "tool-lib.rkt" "drracket"))
(define full-sexp
(call-with-input-file tool-lib-src
(λ (port)
(with-module-reading-parameterization
(lambda ()
(read port))))))
(register-external-file tool-lib-src)
(let loop ([sexp full-sexp])
(match sexp
[`((#%module-begin ,body ...))
(loop body)]
[`((provide/dr/doc (,x ,name ,ctc ,other ...) ...) ,rest ...)
#`(let #,(map (λ (orig-name ctc)
(define (rewrite obj)
(cond
[(symbol? obj)
(string->symbol (regexp-replace #rx"^drracket:" (symbol->string obj) "drscheme:"))]
[(pair? obj)
(cons (rewrite (car obj))
(rewrite (cdr obj)))]
[else obj]))
(with-syntax ([name (datum->syntax #'tool-name (rewrite orig-name))]
[ctc (datum->syntax #'tool-name (rewrite ctc))])
#`[name
(contract (let ([name ctc]) name) ;; need to replace the names in 'ctc'
name
'drracket
tool-name
(quote name)
(quote-syntax name))]))
name
ctc)
body)]
[`(,a . ,b)
(loop b)]
[`()
(error 'tools-drs.rkt "did not find provide/dr/doc: ~a" full-sexp)])))]))
;; these two definitions are a hack. They give bindings for the drracket: based names that
;; appear in the source of language-object-contract.rkt.
(define (drracket:language:capability-registered? . args) (apply drscheme:language:capability-registered? args))
(define (drracket:language:get-capability-contract . args) (apply drscheme:language:get-capability-contract args))
(define (drracket:language:capability-registered? . args)
(apply drscheme:language:capability-registered? args))
(define (drracket:language:get-capability-contract . args)
(apply drscheme:language:get-capability-contract args))
;; invoke-drs-tool : unit/sig string -> (values (-> void) (-> void))
;; invokes the tools and returns the two phase thunks.
@ -102,5 +61,6 @@ This file sets up the right lexical environment to invoke the tools that want to
(define-values/invoke-unit unit@
(import drscheme:tool^) (export drracket:tool-exports^))
(values phase1 phase2))
tool-name))
tool-name
#t))

47
pkgs/drracket-pkgs/drracket/drracket/private/tools.rkt
View File

@ -4,18 +4,18 @@
racket/list
racket/runtime-path
racket/contract
racket/struct-info
setup/getinfo
mred
framework
framework/splash
drracket/private/drsig
"language-object-contract.rkt"
"wrap-tool-inputs.rkt"
mrlib/switchable-button
net/url
string-constants)
(require (for-syntax racket/base racket/match
compiler/cm-accomplice))
(import [prefix drracket:frame: drracket:frame^]
[prefix drracket:unit: drracket:unit^]
[prefix drracket:rep: drracket:rep^]
@ -29,7 +29,7 @@
[prefix drracket:modes: drracket:modes^]
[prefix drracket:tracing: drracket:tracing^]
[prefix drracket:module-language: drracket:module-language^]
[prefix drracket:module-language-tools: drracket:module-language-tools^]
[prefix drracket:module-language-tools: drracket:module-language-tools/int^]
[prefix drracket:tools-drs: drracket:tools-drs^]
[prefix drracket: drracket:interface^])
(export drracket:tools^)
@ -324,42 +324,6 @@
phase2-thunk)
successfully-loaded-tools))))))))
(define-syntax (wrap-tool-inputs stx)
(syntax-case stx ()
[(_ body tool-name)
(let ()
(define tool-lib-src (collection-file-path "tool-lib.rkt" "drracket"))
(define full-sexp
(call-with-input-file tool-lib-src
(λ (port)
(parameterize ([read-accept-reader #t])
(read port)))))
(register-external-file tool-lib-src)
(let loop ([sexp full-sexp])
(match sexp
[`((#%module-begin ,body ...))
(loop body)]
[`((provide/dr/doc (,x ,name ,ctc ,other ...) ...) ,rest ...)
#`(let #,(map (λ (name ctc)
(with-syntax ([name (datum->syntax #'tool-name name)]
[ctc (datum->syntax #'tool-name ctc)])
#`[name (contract (let ([name ctc]) name)
name
'drracket
tool-name
(quote name)
(quote-syntax name))]))
name
ctc)
body)]
[`(,a . ,b)
(loop b)]
[`()
(error 'tools.rkt "did not find provide/dr/doc: ~a" full-sexp)])))]))
;; invoke-tool : unit/sig string -> (values (-> void) (-> void))
;; invokes the tools and returns the two phase thunks.
(define (invoke-tool unit tool-name)
@ -370,7 +334,8 @@
(define-values/invoke-unit unit@
(import drracket:tool^) (export drracket:tool-exports^))
(values phase1 phase2))
tool-name))
tool-name
#f))
;; show-error : string (union exn TST) -> void
(define (show-error title x)

22
pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt
View File

@ -105,7 +105,7 @@
[prefix drracket:app: drracket:app^]
[prefix drracket:frame: drracket:frame^]
[prefix drracket:text: drracket:text^]
[prefix drracket:rep: drracket:rep^]
[prefix drracket:rep: drracket:rep/int^]
[prefix drracket:language-configuration: drracket:language-configuration/internal^]
[prefix drracket:language: drracket:language^]
[prefix drracket:get/extend: drracket:get/extend^]
@ -117,17 +117,17 @@
[prefix drracket:modes: drracket:modes^]
[prefix drracket:debug: drracket:debug^]
[prefix drracket: drracket:interface^])
(export (rename drracket:unit^ [-frame% frame%]))
(export (rename drracket:unit/int^ [-frame% frame%]))
(init-depend drracket:module-language/int^)
(define-struct teachpack-callbacks
(get-names ;; settings -> (listof string)
add ;; settings path -> settings
remove ;; string[returned from teachpack-names] settings -> settings
remove-all ;; settings -> settings
))
;; get rid of set-user-teachpack-cache method
(define struct:teachpack-callbacks struct:drracket:unit:teachpack-callbacks)
(define teachpack-callbacks? drracket:unit:teachpack-callbacks?)
(define teachpack-callbacks-get-names drracket:unit:teachpack-callbacks-get-names)
(define teachpack-callbacks-add drracket:unit:teachpack-callbacks-add)
(define teachpack-callbacks-remove drracket:unit:teachpack-callbacks-remove)
(define teachpack-callbacks-remove-all drracket:unit:teachpack-callbacks-remove-all)
(define make-teachpack-callbacks drracket:unit:teachpack-callbacks)
(define teachpack-callbacks drracket:unit:teachpack-callbacks)
(keymap:add-to-right-button-menu
(let ([old (keymap:add-to-right-button-menu)])

67
pkgs/drracket-pkgs/drracket/drracket/private/wrap-tool-inputs.rkt Normal file
View File

@ -0,0 +1,67 @@
#lang racket/base
(provide wrap-tool-inputs)
(require racket/contract)
(require (for-syntax racket/base
racket/match
syntax/modread
compiler/cm-accomplice))
(define-syntax (wrap-tool-inputs stx)
(syntax-case stx ()
[(_ body tool-name replace?)
(let ()
(define do-regexp-replace? (syntax-e #'replace?))
(define tool-lib-src (collection-file-path "tool-lib.rkt" "drracket"))
(define full-sexp
(call-with-input-file tool-lib-src
(λ (port)
(with-module-reading-parameterization
(lambda ()
(read port))))))
(register-external-file tool-lib-src)
(let loop ([sexp full-sexp])
(match sexp
[`((#%module-begin ,body ...))
(loop body)]
[`((provide/dr/doc ,clauses ...) ,rest ...)
(let ()
(define (rewrite obj)
(if do-regexp-replace?
(let loop ([obj obj])
(cond
[(symbol? obj)
(string->symbol (regexp-replace #rx"^drracket:"
(symbol->string obj)
"drscheme:"))]
[(pair? obj)
(cons (loop (car obj)) (loop (cdr obj)))]
[else obj]))
obj))
(define let-bindingss
(for/list ([clause (in-list clauses)])
(match clause
[`(struct-doc ,struct-name ((,field-name ,field-ctc) ...) ,other ...)
'()]
[`(,(or 'proc-doc/names 'proc-doc 'thing-doc 'parameter-doc)
,(? symbol? orig-name)
,ctc
,other ...)
(with-syntax ([name (datum->syntax #'tool-name (rewrite orig-name))]
[ctc (datum->syntax #'tool-name (rewrite ctc))])
(list
#`[name
(contract
(let ([name ctc]) name) ;; need to replace the names in 'ctc'
name
'drracket
tool-name
(quote name)
(quote-syntax name))]))])))
#`(let #,(apply append let-bindingss)
body))]
[`(,a . ,b)
(loop b)]
[`()
(error 'tools-drs.rkt "did not find provide/dr/doc: ~a" full-sexp)])))]))

649
pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt
View File

@ -11,32 +11,100 @@ all of the names in the tools library, for use defining keybindings
racket/unit
racket/contract
racket/class
racket/struct-info
;; these have to be absolute requires for `include-extracted'
;; to work with this file.
drracket/private/link
drracket/private/drsig
drracket/private/language-object-contract
drracket/private/local-member-names
framework
framework/splash
mrlib/switchable-button
scribble/srcdoc)
scribble/srcdoc
net/url)
(require (for-syntax racket/base))
(require (for-syntax racket/base racket/list racket/struct-info))
(generate-delayed-documents) ; avoids a distribution dependency on `scribblings/tools/doc-util'
(require (for-doc drracket/private/ts
racket/base scribble/manual
scribblings/tools/doc-util
net/url
(for-label errortrace/errortrace-key
racket/place
racket/pretty
mzlib/pconvert
syntax/toplevel)))
syntax/toplevel
drracket/tool-lib)))
(define-values/invoke-unit/infer drracket@)
;; these two declarations produce all of the struct names
;; but with "drscheme" in front instead of drracket
(begin
(module drr-structs racket/base
(require drracket/private/local-member-names)
(provide
(combine-out
(struct-out drracket:language-configuration:language-settings)
(struct-out drracket:unit:teachpack-callbacks)
(struct-out drracket:language:text/pos)
(struct-out drracket:language:simple-settings)
(struct-out drracket:modes:mode))))
(require racket/require
(filtered-in
(λ (x) (regexp-replace #rx"drracket:" x "drscheme:"))
(submod "." drr-structs))))
;; would like to use except here, but that
;; is allowed only on imports,
;; so just rename to something unused.
(define-syntax (dv/iu/i/drop-struct stx)
(syntax-case stx ()
[(_ sig stuff ...)
(let ()
(define (get-ids prefix sid-flds)
(syntax-case sid-flds ()
[(struct-id constructor? fields ...)
(let ()
(define include-constructor? (syntax-e #'constructor?))
(unless (boolean? include-constructor?)
(raise-syntax-error #f "expected boolean?" stx #'constructor?))
(define (fmt str . args)
(define orig
(string->symbol
(apply format str (map (λ (x) (if (syntax? x) (syntax-e x) x))
args))))
`(,(datum->syntax #'sig (string->symbol (format "___~a" orig)))
,(datum->syntax #'sig orig)))
(append (list (fmt "~a~a?" prefix #'struct-id))
(if include-constructor?
(list (fmt "~a~a" prefix #'struct-id))
'())
(for/list ([fld (in-list (syntax->list #'(fields ...)))])
(fmt "~a~a-~a" prefix #'struct-id fld))))]))
#`(define-values/invoke-unit/infer
(export (rename sig
#,@(apply
append
(for/list ([sid-flds (syntax->list #'(stuff ...))])
(append (get-ids 'drracket: sid-flds)
(get-ids 'drscheme: sid-flds))))))
drracket@))]))
(dv/iu/i/drop-struct
drscheme/drracket:tool^
(language-configuration:language-settings #t language settings)
(unit:teachpack-callbacks #t get-names add remove remove-all)
(language:text/pos #t text start end)
(language:simple-settings #t case-sensitive printing-style
fraction-style show-sharing
insert-newlines annotations)
(modes:mode #t name surrogate repl-submit matches-language))
(provide-signature-elements drracket:tool-cm^) ;; provide all of the classes & interfaces
(provide-signature-elements drscheme:tool-cm^) ;; provide the classes & interfaces w/ drscheme: prefix
@ -50,38 +118,77 @@ all of the names in the tools library, for use defining keybindings
(language-object-abstraction drracket:language:object/c #t)
(define-syntax (provide/dr/doc stx)
(let* ([munge-id
(λ (stx)
(datum->syntax
stx
(string->symbol
(regexp-replace #rx"^drracket:" (symbol->string (syntax-e stx)) "drscheme:"))
stx))]
[defthings
(syntax-case stx ()
[(_ case ...)
(map
(λ (case)
(with-syntax ([(id ctc)
(syntax-case case (proc-doc/names proc-doc parameter-doc parameter/c)
[(proc-doc/names id ctc . stuff)
(identifier? #'id)
#'(id ctc)]
[(proc-doc id ctc . stuff)
(identifier? #'id)
#'(id ctc)]
[(parameter-doc id (parameter/c ctc) arg-id . stuff)
(and (identifier? #'id)
(identifier? #'arg-id))
#'(id (parameter/c ctc))]
[_
(raise-syntax-error 'provide/dr/doc "unknown thing" case)])])
(with-syntax ([mid (munge-id #'id)])
#`(thing-doc mid ctc (@undefined-const "This is provided for backwards compatibility; new code should use " (racket id) " instead.")))))
(syntax->list #'(case ...)))])])
(define (munge-id stx)
(datum->syntax
stx
(string->symbol
(regexp-replace #rx"drracket:" (symbol->string (syntax-e stx)) "drscheme:"))
stx))
(define (handle-one id ctc)
(with-syntax ([id id]
[ctc ctc]
[mid (munge-id id)])
#`(thing-doc
mid ctc
("This binding provided for backwards compatibility; new code should use "
(racket id)
" instead."))))
(define (remove-src-locs stx)
(let loop ([x stx])
(cond
[(syntax? x) (datum->syntax x (loop (syntax-e x)) #f)]
[(pair? x) (cons (loop (car x)) (loop (cdr x)))]
[else x])))
(define (handle-struct a fld/ctc omit-constructor?)
(with-syntax ([([fld ctc] ...) fld/ctc])
(define (ds fmt . args)
(datum->syntax a
(string->symbol (apply format fmt args))))
(let* ([flds (syntax->list #'(fld ...))]
[ctcs (syntax->list #'(ctc ...))]
[st-name (syntax-e a)]
[pid (ds "~a?" st-name)])
#`(combine-out
#,(handle-one pid (remove-src-locs #`(-> any/c boolean?)))
#,(if omit-constructor?
#'(combine-out)
(handle-one (ds "make-~a" st-name) (remove-src-locs #`(-> #,@ctcs #,pid))))
#,@(for/list ([fld (in-list flds)]
[ctc (in-list ctcs)])
(define id (ds "~a-~a" st-name (syntax-e fld)))
(handle-one id (remove-src-locs #`(-> #,pid #,ctc))))))))
(define defthings
(syntax-case stx ()
[(_ rst ...)
#`(provide/doc #,@defthings rst ...)])))
[(_ case ...)
(for/list ([case (in-list (syntax->list #'(case ...)))])
(syntax-case case (thing-doc
proc-doc/names proc-doc
parameter-doc parameter/c
struct-doc)
[(proc-doc/names id ctc . stuff)
(identifier? #'id)
(handle-one #'id #'ctc)]
[(proc-doc id ctc . stuff)
(identifier? #'id)
(handle-one #'id #'ctc)]
[(parameter-doc id (parameter/c ctc) arg-id . stuff)
(and (identifier? #'id)
(identifier? #'arg-id))
(handle-one #'id (remove-src-locs #`(parameter/c ctc)))]
[(thing-doc id ctc . stuff)
(identifier? #'id)
(handle-one #'id #'ctc)]
[(struct-doc a ([fld ctc] ...) #:omit-constructor stuff)
(handle-struct #'a #'([fld ctc] ...) #t)]
[(struct-doc a ([fld ctc] ...) stuff)
(handle-struct #'a #'([fld ctc] ...) #f)]
[_
(raise-syntax-error 'provide/dr/doc "unknown clause" case)]))]))
(syntax-case stx ()
[(_ rst ...)
#`(provide #,@defthings rst ...)]))
(provide/dr/doc
@ -244,7 +351,8 @@ all of the names in the tools library, for use defining keybindings
a parameter that kills the user's custodian; and}
@item{the snip-class-list, returned by
@racket[get-the-snip-class-list]
is initialized with all of the snipclasses in DrRacket's eventspace's snip-class-list.}]})
is initialized with all of the snipclasses in DrRacket's eventspace's
snip-class-list.}]})
(proc-doc/names
drracket:eval:get-snip-classes
@ -254,7 +362,7 @@ all of the names in the tools library, for use defining keybindings
(proc-doc/names
drracket:eval:expand-program
(->* ((or/c port? drracket:language:text/pos?)
(->* ((or/c input-port? drracket:language:text/pos?)
drracket:language-configuration:language-settings?
boolean?
(-> void?)
@ -324,7 +432,7 @@ all of the names in the tools library, for use defining keybindings
(-> void?)
(-> void?))
(#:gui-modules? boolean?)
(-> (or/c port? drracket:language:text/pos?)
(-> (or/c input-port? drracket:language:text/pos?)
(-> (or/c eof-object? syntax? (cons/c string? any/c))
(-> any)
any)
@ -347,7 +455,7 @@ all of the names in the tools library, for use defining keybindings
(-> void?)
(-> void?))
(#:gui-modules? boolean?)
(-> (or/c port? drracket:language:text/pos?)
(-> (or/c input-port? drracket:language:text/pos?)
(-> (or/c eof-object? syntax? (cons/c string? any/c))
(-> any)
any)
@ -466,9 +574,10 @@ all of the names in the tools library, for use defining keybindings
and a clickable icon for the source of the error (read & syntax errors show their source
locations and otherwise the first place in the stack trace is shown).
If @racket[stack] is false, then the stack traces embedded in the @racket[exn] argument (if any) are used.
Specifically, this function looks for a stacktrace via
@racket[errortrace-key] in the continuation marks of @racket[exn] and @racket[continuation-mark-set->context].
If @racket[stack] is false, then the stack traces embedded in the @racket[exn] argument (if any)
are used. Specifically, this function looks for a stacktrace via
@racket[errortrace-key] in the continuation marks of @racket[exn] and
@racket[continuation-mark-set->context].
If @racket[stack] is not false, that stack is added to the stacks already in the exception.
@ -513,6 +622,62 @@ all of the names in the tools library, for use defining keybindings
()
@{Adds the profiling preferences panel.})
(proc-doc/names
drracket:debug:make-debug-eval-handler
(-> (-> any/c any) (-> any/c any))
(oe)
@{Returns a function suitable for use with
@racket[current-eval].
The result function first adds debugging information to
its argument and then passes it to @racket[oe].})
(parameter-doc
drracket:debug:test-coverage-enabled
(parameter/c boolean?)
enabled?
@{Determines if the test-coverage annotation is added
by the result of @racket[drracket:debug:make-debug-eval-handler].})
(thing-doc
drracket:debug:test-coverage-on-style-name
string?
@{The name of the
@racket[style%] object (in @racket[editor:get-standard-style-name])
used to indicate a covered region of code.})
(thing-doc
drracket:debug:test-coverage-off-style-name
string?
@{The name of the
@racket[style%] object (in @racket[editor:get-standard-style-name])
used to indicate a region of code that tests (or any code, really)
didn't cover.})
(parameter-doc
drracket:debug:profiling-enabled
(parameter/c boolean?)
enabled?
@{Determines if the profiling annotation is added
by the result of @racket[drracket:debug:make-debug-eval-handler].})
(proc-doc/names
drracket:debug:bug-info->ticket-url
(-> (listof (cons/c symbol? (or/c #f string?)))
url?)
(query)
@{Builds a url that goes to the trac report system.
The @racket[query] argument is used as the
url's query field.})
(thing-doc
drracket:debug:small-planet-bitmap
(is-a?/c bitmap%)
@{The icon used in the DrRacket REPL when an exception is
raised that includes blame information blaming a PLaneT
package. (Clicking the icon connects to the PLaneT bug
report form.)})
(proc-doc/names
drracket:debug:open-and-highlight-in-file
(->* ((or/c srcloc? (listof srcloc?)))
@ -610,6 +775,15 @@ all of the names in the tools library, for use defining keybindings
})
(proc-doc
drracket:debug:get-error-color
(-> (is-a?/c color%))
@{Returns the background color used to highlight errors in the definitions window
(and other places, possibly).
The result depends on the @racket['framework:white-on-black?] preference
setting.})
(proc-doc/names
drracket:debug:show-backtrace-window
(->* (string?
@ -691,6 +865,11 @@ all of the names in the tools library, for use defining keybindings
Otherwise, calls @racket[send-main-page] with no arguments.})
(proc-doc
drracket:help-desk:goto-plt-license
(-> void?)
@{Opens the user's web browser and points it at the license for PLT software.})
;
;
@ -756,6 +935,50 @@ all of the names in the tools library, for use defining keybindings
added, then @racket[add-sep] is called before the menu item is
created.
})
(struct-doc
drracket:unit:teachpack-callbacks
([get-names (-> any/c (listof string?))]
[add (-> any/c path-string? any/c)]
[remove (-> path-string? any/c any/c)]
[remove-all (-> any/c any/c)])
@{Holds callbacks for teachpack operations. DrRacket invokes
these functions in response to GUI operations being triggered.
Each of the @racket[any/c]s that appear in the field
contracts are actually the settings of a language.
The @racket[get-names] field returns the names
of the teachpacks in the given settings; @racket[add]
returns a new settings that includes the @racket[path-string?]
argument as a new teachpack; @racket[remove] removes the
given teachpack and @racket[remove-all] removes them all.})
(thing-doc
drracket:unit:struct:teachpack-callbacks
struct-type?
@{This is an alias for @racket[struct:drracket:unit:teachpack-callbacks].})
(thing-doc
drracket:unit:make-teachpack-callbacks
procedure?
@{This is an alias for @racket[make-drracket:unit:teachpack-callbacks].})
(proc-doc/names
drracket:unit:find-symbol
(-> (is-a?/c text%) exact-nonnegative-integer? string?)
(text pos)
@{returns a string that corresponds to the a
symbol surrounding @racket[pos] (in @racket[text]).
This is intended to be used with the ``f1'' keybinding
for searching in the documentation, so the result is
not always a symbol, but instead a best effort to find
something that is likely to be useful to search for around
a point in the @racket[text].})
;
@ -778,12 +1001,11 @@ all of the names in the tools library, for use defining keybindings
(proc-doc/names
drracket:modes:add-mode
(string?
(or/c false/c (is-a?/c mode:surrogate-text<%>))
((is-a?/c drracket:rep:text%) number? . -> . boolean?)
((or/c false/c (listof string?)) . -> . boolean?)
. -> .
drracket:modes:mode?)
(-> string?
(or/c #f (is-a?/c mode:surrogate-text<%>))
(-> (is-a?/c drracket:rep:text%) number? boolean?)
(-> (or/c #f (listof string?)) boolean?)
drracket:modes:mode?)
(name surrogate repl-submit matches-language)
@{Adds a mode to DrRacket. Returns a mode value
that identifies the mode.
@ -824,12 +1046,20 @@ all of the names in the tools library, for use defining keybindings
See also
@racket[drracket:modes:get-modes].})
(proc-doc/names
drracket:modes:mode?
(any/c . -> . boolean?)
(val)
@{Determines if @racket[val] is a mode.})
(struct-doc
drracket:modes:mode
([name string?]
[surrogate (or/c #f (is-a?/c mode:surrogate-text<%>))]
[repl-submit (-> (is-a?/c drracket:rep:text%) number? boolean?)]
[matches-language (-> (or/c #f (listof string?)) boolean?)])
#:omit-constructor
@{See @racket[drracket:modes:add-mode] for details on modes.})
(thing-doc
drracket:modes:struct:mode
struct-type?
@{An alias for @racket[struct:drracket:modes:mode].})
(proc-doc/names
drracket:modes:get-modes
(-> (listof drracket:modes:mode?))
@ -839,42 +1069,6 @@ all of the names in the tools library, for use defining keybindings
See also
@racket[drracket:modes:add-mode].})
(proc-doc/names
drracket:modes:mode-name
(drracket:modes:mode? . -> . string?)
(mode)
@{Extracts the name of the mode.
See also
@racket[drracket:modes:add-mode].})
(proc-doc/names
drracket:modes:mode-surrogate
(drracket:modes:mode? . -> . (or/c false/c (is-a?/c mode:surrogate-text<%>)))
(mode)
@{Extracts the surrogate of the mode.
See also
@racket[drracket:modes:add-mode].})
(proc-doc/names
drracket:modes:mode-repl-submit
(drracket:modes:mode? . -> . any)
(mode)
@{Extracts the repl submission predicate of the mode.
See also
@racket[drracket:modes:add-mode].})
(proc-doc/names
drracket:modes:mode-matches-language
(drracket:modes:mode? . -> . ((or/c false/c (listof string?)) . -> . boolean?))
(mode)
@{Extracts the language matching predicate of the mode.
See also
@racket[drracket:modes:add-mode].})
;
;
@ -900,6 +1094,7 @@ all of the names in the tools library, for use defining keybindings
()
@{Returns a style delta that matches the style and color of the
phrase ``Welcome to'' in the beginning of the interactions window.})
(proc-doc/names
drracket:rep:get-dark-green-delta
@ -908,6 +1103,12 @@ all of the names in the tools library, for use defining keybindings
@{Returns a style delta that matches the style and color of the
name of a language in the interactions window.})
(proc-doc
drracket:rep:get-error-delta
(-> (is-a?/c style-delta%))
@{Returns a style delta that matches the style and color of
errors that get shown in the interactions window.})
(proc-doc/names
drracket:rep:get-drs-bindings-keymap
(-> (is-a?/c keymap%))
@ -949,6 +1150,14 @@ all of the names in the tools library, for use defining keybindings
@{This parameter is used by @method[drracket:rep:text% evaluate-from-port].
When it is a thunk, then DrRacket invokes the thunk on the user's thread
as the last thing it does (before cleaning up).})
(parameter-doc
drracket:rep:current-language-settings
(parameter/c drracket:language-configuration:language-settings?)
language-settings
@{This parameter is set (on the user's thread) to the
@racket[drracket:language-configuration:language-settings]
for the currently running language.})
@ -1218,61 +1427,26 @@ all of the names in the tools library, for use defining keybindings
or
@racket[preferences:set].})
(proc-doc/names
(struct-doc
drracket:language-configuration:language-settings
((or/c (is-a?/c drracket:language:language<%>)
drracket:language:object/c)
any/c
. -> .
drracket:language-configuration:language-settings?)
(language settings)
@{This is the constructor for a record consisting of two
elements, a language and its settings.
([language (or/c (is-a?/c drracket:language:language<%>)
drracket:language:object/c)]
[settings any/c])
@{This struct pairs together a language and some specific settings
for the language.
The settings is a language-specific record that holds a
value describing a parameterization of the language.
It has two selectors,
@racket[drracket:language-configuration:language-settings-language]
and
@racket[drracket:language-configuration:language-settings-settings], and a predicate,
@racket[drracket:language-configuration:language-settings?]})
value describing a parameterization of the language.})
#;
(proc-doc/names
(thing-doc
drracket:language-configuration:struct:language-settings
struct-type?
@{An alias for @racket[struct:drracket:language-configuration:language-settings].})
(thing-doc
drracket:language-configuration:make-language-settings
((or/c (is-a?/c drracket:language:language<%>) drracket:language:object/c)
any/c
. -> .
drracket:language-configuration:language-settings?)
(language settings)
@{This is an alias for @racket[drrracket:language-configuration:language-settings]})
(proc-doc/names
drracket:language-configuration:language-settings-settings
(-> drracket:language-configuration:language-settings?
any/c)
(ls)
@{Extracts the settings field of a language-settings.})
(proc-doc/names
drracket:language-configuration:language-settings-language
(drracket:language-configuration:language-settings?
. -> .
(or/c (is-a?/c drracket:language:language<%>)
drracket:language:object/c))
(ls)
@{Extracts the language field of a language-settings.})
(proc-doc/names
drracket:language-configuration:language-settings?
(any/c . -> . boolean?)
(val)
@{Determines if the argument is a language-settings or not.})
procedure?
@{An alias for @racket[make-drracket:language-configuration:language-settings].})
(proc-doc/names
drracket:language-configuration:language-dialog
@ -1366,7 +1540,8 @@ all of the names in the tools library, for use defining keybindings
(item @racket['key : contract = default]
"--- " desc ...)])])
(itemize
@cap[drracket:check-syntax-button boolean? #t]{controls the visiblity of the check syntax button}
@cap[drracket:check-syntax-button boolean? #t]{controls the visiblity of
the check syntax button}
@cap[drracket:language-menu-title string?
(string-constant scheme-menu-name)]{
controls the name of the menu just to the right of the language
@ -1640,7 +1815,8 @@ all of the names in the tools library, for use defining keybindings
use-copy?)
@{Like
@racket[drracket:language:create-module-based-stand-alone-executable], but packages the stand-alone executable into a distribution.})
@racket[drracket:language:create-module-based-stand-alone-executable],
but packages the stand-alone executable into a distribution.})
(proc-doc/names
drracket:language:create-distribution-for-executable
@ -1653,14 +1829,15 @@ all of the names in the tools library, for use defining keybindings
gui?
make-executable)
@{Creates a distribution where the given @racket[make-executable] procedure
creates the stand-alone executable to be distributed.
The @racket[make-executable] procedure is given the name of the
executable to create. The @racket[gui?] argument is needed in case the
executable's name (which @racket[drracket:language:create-distribution-for-executable]
must generate) depends on the type of executable. During the distribution-making
process, a progress dialog is shown to the user, and the user can click an
@onscreen{Abort} button that sends a break to the current thread.})
@{Creates a distribution where the given
@racket[make-executable] procedure
creates the stand-alone executable to be distributed.
The @racket[make-executable] procedure is given the name of the
executable to create. The @racket[gui?] argument is needed in case the
executable's name (which @racket[drracket:language:create-distribution-for-executable]
must generate) depends on the type of executable. During the distribution-making
process, a progress dialog is shown to the user, and the user can click an
@onscreen{Abort} button that sends a break to the current thread.})
(proc-doc/names
drracket:language:create-module-based-launcher
@ -1676,7 +1853,8 @@ all of the names in the tools library, for use defining keybindings
use-copy?)
@{This procedure is identical to
@racket[drracket:language:create-module-based-stand-alone-executable], except that it creates a launcher instead of a
@racket[drracket:language:create-module-based-stand-alone-executable],
except that it creates a launcher instead of a
stand-alone executable.})
(proc-doc/names
@ -1721,150 +1899,49 @@ all of the names in the tools library, for use defining keybindings
procedure is invoked.
})
(proc-doc/names
drracket:language:text/pos-text
(drracket:language:text/pos? . -> . (is-a?/c text%))
(text/pos)
@{Selects the @racket[text%] from a text/pos.})
(proc-doc/names
drracket:language:text/pos-start
(drracket:language:text/pos? . -> . number?)
(text/pos)
@{Selects the starting position from a text/pos.})
(proc-doc/names
drracket:language:text/pos-end
(drracket:language:text/pos? . -> . number?)
(text/pos)
@{Selects the ending position from a text/pos.})
(proc-doc/names
drracket:language:text/pos?
(any/c . -> . boolean?)
(val)
@{Returns @racket[#t] if @racket[val] is a text/pos, and @racket[#f]
otherwise.})
(proc-doc/names
(struct-doc
drracket:language:text/pos
((is-a?/c text%) number? number?
. -> .
drracket:language:text/pos?)
(text start end)
@{Constructs a text/pos.})
([text (is-a?/c text%)]
[start exact-nonnegative-integer?]
[end exact-nonnegative-integer?])
@{A record that tracks a @racket[text%] object and a range inside it.})
(proc-doc/names
(thing-doc
drracket:language:make-text/pos
((is-a?/c text%) number? number?
. -> .
drracket:language:text/pos?)
(text start end)
@{An alias for @racket[drracket:language:text/pos]})
procedure?
@{An alias for @racket[make-drracket:language:text/pos].})
(proc-doc/names
drracket:language:simple-settings-case-sensitive
(drracket:language:simple-settings? . -> . boolean?)
(simple-settings)
@{Extracts the case-sensitive setting from a simple-settings.})
(thing-doc
drracket:language:struct:text/pos
struct-type?
@{An alias for @racket[struct:drracket:language:text/pos].})
(proc-doc/names
drracket:language:simple-settings-printing-style
(drracket:language:simple-settings?
. -> .
(or/c 'constructor 'quasiquote 'write 'trad-write 'print))
(simple-settings)
@{Extracts the printing-style setting from a simple-settings.})
(proc-doc/names
drracket:language:simple-settings-fraction-style
(drracket:language:simple-settings?
. -> .
(or/c 'mixed-fraction
'mixed-fraction-e
'repeating-decimal
'repeating-decimal-e))
(simple-settings)
@{Extracts the fraction-style setting from a simple-settings.})
(proc-doc/names
drracket:language:simple-settings-show-sharing
(drracket:language:simple-settings?
. -> .
boolean?)
(simple-settings)
@{Extracts the show-sharing setting from a simple-settings.})
(proc-doc/names
drracket:language:simple-settings-insert-newlines
(drracket:language:simple-settings?
. -> .
boolean?)
(simple-settings)
@{Extracts the insert-newline setting from a simple-settings.})
(proc-doc/names
drracket:language:simple-settings-annotations
(drracket:language:simple-settings?
. -> .
(or/c 'none 'debug 'debug/profile 'test-coverage))
(simple-settings)
@{Extracts the debugging setting from a simple-settings.})
(proc-doc/names
drracket:language:simple-settings?
(any/c . -> . boolean?)
(val)
@{Determines if @racket[val] is a simple-settings.})
(proc-doc/names
(struct-doc
drracket:language:simple-settings
(-> boolean?
(or/c 'constructor 'quasiquote 'write 'trad-write 'print)
(or/c 'mixed-fraction 'mixed-fraction-e 'repeating-decimal 'repeating-decimal-e)
boolean?
boolean?
(or/c 'none 'debug 'debug/profile 'test-coverage)
drracket:language:simple-settings?)
(case-sensitive
printing-style
fraction-style
show-sharing
insert-newlines
annotations)
@{Constructs a simple settings.})
([case-sensitive boolean?]
[printing-style (or/c 'constructor
'quasiquote
'write
'trad-write
'print)]
[fraction-style (or/c 'mixed-fraction
'mixed-fraction-e
'repeating-decimal
'repeating-decimal-e)]
[show-sharing boolean?]
[insert-newlines boolean?]
[annotations (or/c 'none 'debug 'debug/profile 'test-coverage)])
@{A struct that tracks commonly used settings for a language.})
(proc-doc/names
(thing-doc
drracket:language:make-simple-settings
(-> boolean?
(or/c 'constructor 'quasiquote 'write 'trad-write 'print)
(or/c 'mixed-fraction 'mixed-fraction-e 'repeating-decimal 'repeating-decimal-e)
boolean?
boolean?
(or/c 'none 'debug 'debug/profile 'test-coverage)
drracket:language:simple-settings?)
(case-sensitive
printing-style
fraction-style
show-sharing
insert-newlines
annotations)
@{An alias for @racket[drracket:language:simple-settings].})
procedure?
@{An alias for @racket[make-drracket:language:simple-settings].})
(thing-doc
drracket:language:struct:simple-settings
struct-type?
@{An alias for @racket[struct:drracket:language:simple-settings].})
(proc-doc/names
drracket:language:simple-settings->vector

2
pkgs/drracket-pkgs/drracket/info.rkt
View File

@ -26,7 +26,7 @@
"racket-index"
"racket-doc"
"html-lib"
"images"
"images-lib"
"icons"
"typed-racket-more"
"trace"

1
pkgs/plt-services/meta/props
View File

@ -736,6 +736,7 @@ path/s is either such a string or a list of them.
"pkgs/drracket-pkgs/drracket-test/tests/drracket/teaching-lang-sharing-modules.rkt" drdr:timeout 800
"pkgs/drracket-pkgs/drracket-test/tests/drracket/teachpack.rkt" responsible (robby matthias) drdr:command-line (gracket *)
"pkgs/drracket-pkgs/drracket-test/tests/drracket/test-engine-test.rkt" responsible (sperber) drdr:command-line (gracket *) drdr:timeout 480
"pkgs/drracket-pkgs/drracket-test/tests/drracket/tool-lib-and-sig.rkt" drdr:command-line (raco "make" *)
"pkgs/drracket-pkgs/drracket-test/tests/jpr" responsible (mflatt)
"pkgs/drracket-pkgs/drracket-test/tests/jpr/balle-grav-frot.ss" drdr:command-line (mzc "-k" *)
"pkgs/drracket-pkgs/drracket-test/tests/jpr/dessine-arbre.ss" drdr:command-line (mzc "-k" *)