From f6267ad66104ecac8c1907503b19510d089b3dc4 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 20 Sep 2013 14:37:11 -0500 Subject: [PATCH] make the drracket/tool-lib library 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)) --- .../drracket/private/drsig.rkt | 49 +- .../tests/drracket/tool-lib-and-sig.rkt | 27 + .../drracket/drracket/private/debug.rkt | 2 +- .../drracket/drracket/private/eval.rkt | 1 + .../drracket/drracket/private/frame.rkt | 4 +- .../drracket/drracket/private/help-desk.rkt | 6 +- .../private/language-configuration.rkt | 52 +- .../drracket/drracket/private/language.rkt | 43 +- .../drracket/drracket/private/link.rkt | 2 +- .../drracket/private/local-member-names.rkt | 47 +- .../drracket/drracket/private/main.rkt | 5 +- .../drracket/drracket/private/modes.rkt | 22 +- .../private/module-language-tools.rkt | 2 +- .../drracket/private/module-language.rkt | 4 +- .../drracket/drracket/private/rep.rkt | 5 +- .../drracket/drracket/private/tools-drs.rkt | 64 +- .../drracket/drracket/private/tools.rkt | 47 +- .../drracket/drracket/private/unit.rkt | 22 +- .../drracket/private/wrap-tool-inputs.rkt | 67 ++ .../drracket/drracket/tool-lib.rkt | 649 ++++++++++-------- pkgs/drracket-pkgs/drracket/info.rkt | 2 +- pkgs/plt-services/meta/props | 1 + 22 files changed, 636 insertions(+), 487 deletions(-) create mode 100644 pkgs/drracket-pkgs/drracket-test/tests/drracket/tool-lib-and-sig.rkt create mode 100644 pkgs/drracket-pkgs/drracket/drracket/private/wrap-tool-inputs.rkt diff --git a/pkgs/drracket-pkgs/drracket-plugin-lib/drracket/private/drsig.rkt b/pkgs/drracket-pkgs/drracket-plugin-lib/drracket/private/drsig.rkt index a55c56a00b..100bdd4d1e 100644 --- a/pkgs/drracket-pkgs/drracket-plugin-lib/drracket/private/drsig.rkt +++ b/pkgs/drracket-pkgs/drracket-plugin-lib/drracket/private/drsig.rkt @@ -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^ ()) diff --git a/pkgs/drracket-pkgs/drracket-test/tests/drracket/tool-lib-and-sig.rkt b/pkgs/drracket-pkgs/drracket-test/tests/drracket/tool-lib-and-sig.rkt new file mode 100644 index 0000000000..414284c542 --- /dev/null +++ b/pkgs/drracket-pkgs/drracket-test/tests/drracket/tool-lib-and-sig.rkt @@ -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^))) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt index 28a71968b2..7442bfea0c 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt @@ -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^] diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/eval.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/eval.rkt index 72e1a040a9..27e0107455 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/eval.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/eval.rkt @@ -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) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/frame.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/frame.rkt index c6c9142ccf..dc7d4721c9 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/frame.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/frame.rkt @@ -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 "") diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/help-desk.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/help-desk.rkt index 0cc5d4c94f..91852b16ae 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/help-desk.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/help-desk.rkt @@ -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) '()) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt index a8a045686c..ce9c47b822 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt @@ -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) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt index 29393741b4..377e8192b2 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt @@ -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 '?)] diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/link.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/link.rkt index 3981cc42dd..1f04819c2d 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/link.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/link.rkt @@ -25,7 +25,7 @@ "module-language-tools.rkt" "interface.rkt") -(provide drracket@) +(provide drracket@ drscheme/drracket:tool^) (define-compound-unit/infer drracket-unit@ (import) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/local-member-names.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/local-member-names.rkt index 04ae18b06e..dbbb75523a 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/local-member-names.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/local-member-names.rkt @@ -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) \ No newline at end of file + 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)) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt index b6b3828646..c7f54d8f85 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt @@ -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) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/modes.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/modes.rkt index ba9d926c88..d525305328 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/modes.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/modes.rkt @@ -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)) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/module-language-tools.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/module-language-tools.rkt index 6f13427b35..cccd654642 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/module-language-tools.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/module-language-tools.rkt @@ -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 '()) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt index 02e0572c8a..a7ec0b5a9a 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt @@ -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^) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/rep.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/rep.rkt index cd57559e48..04be06af55 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/rep.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/rep.rkt @@ -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)) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/tools-drs.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/tools-drs.rkt index f3376d9b86..ebcafcdfba 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/tools-drs.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/tools-drs.rkt @@ -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)) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/tools.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/tools.rkt index c08eecef49..88ec6d1938 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/tools.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/tools.rkt @@ -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) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt index 009da48e5b..dbd9153e52 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt @@ -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)]) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/wrap-tool-inputs.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/wrap-tool-inputs.rkt new file mode 100644 index 0000000000..da386c9e7b --- /dev/null +++ b/pkgs/drracket-pkgs/drracket/drracket/private/wrap-tool-inputs.rkt @@ -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)])))])) diff --git a/pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt b/pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt index 5f9c2351de..40bfa6b18b 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt @@ -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 diff --git a/pkgs/drracket-pkgs/drracket/info.rkt b/pkgs/drracket-pkgs/drracket/info.rkt index 4023fa8f56..97a6875dee 100644 --- a/pkgs/drracket-pkgs/drracket/info.rkt +++ b/pkgs/drracket-pkgs/drracket/info.rkt @@ -26,7 +26,7 @@ "racket-index" "racket-doc" "html-lib" - "images" + "images-lib" "icons" "typed-racket-more" "trace" diff --git a/pkgs/plt-services/meta/props b/pkgs/plt-services/meta/props index 2a02bbc872..b0f16762ff 100755 --- a/pkgs/plt-services/meta/props +++ b/pkgs/plt-services/meta/props @@ -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" *)