diff --git a/collects/drscheme/info.rkt b/collects/drscheme/info.rkt index 48cd8e09d5..4a7185bb45 100644 --- a/collects/drscheme/info.rkt +++ b/collects/drscheme/info.rkt @@ -1,7 +1,10 @@ #lang setup/infotab -(define tools '("syncheck.rkt" #;"sprof.rkt")) -(define tool-names '("Check Syntax" #;"Sampling Profiler")) +;(define tools '("sprof.rkt")) +;(define tool-names '("Sampling Profiler")) + +(define drracket-tools '("syncheck.rkt")) +(define drracket-tool-names '("Check Syntax")) (define gracket-launcher-names '("DrRacket")) (define gracket-launcher-libraries '("drscheme.rkt")) diff --git a/collects/drscheme/private/tools.rkt b/collects/drscheme/private/tools.rkt index a820708815..0b734f42be 100644 --- a/collects/drscheme/private/tools.rkt +++ b/collects/drscheme/private/tools.rkt @@ -33,8 +33,8 @@ string-constants) (export drracket:tools^) ;; An installed-tool is -;; (make-installed-tool directory-record module-spec string/#f string/#f string/#f string/#f) -(define-struct installed-tool (dir spec bitmap name url)) +;; (make-installed-tool directory-record module-spec string/#f string/#f string/#f string/#f boolean) +(define-struct installed-tool (dir spec bitmap name url drracket?) #:transparent) ;; installed-tools : (list-of installed-tool) (define installed-tools null) @@ -82,10 +82,16 @@ string-constants) ;; all-tool-directories : -> (list-of directory-record) (define (all-tool-directories) - (find-relevant-directory-records '(tools tool-icons tool-names tool-urls))) + (find-relevant-directory-records '(drracket-tools drracket-tool-icons drracket-tool-names drracket-tool-urls + tools tool-icons tool-names tool-urls))) ;; installed-tools-for-directory : directory-record -> (list-of installed-tool) (define (installed-tools-for-directory coll-dir) + (append (installed-tools-for-directory/keys coll-dir 'tools 'tool-icons 'tool-names 'tool-urls #f) + (installed-tools-for-directory/keys coll-dir 'drracket-tools 'drracket-tool-icons 'drracket-tool-names 'drracket-tool-urls #t))) + +;; installed-tools-for-directory/keys : directory-record symbol symbol symbol symbol boolean -> (list-of installed-tool) +(define (installed-tools-for-directory/keys coll-dir tools-key tool-icons-key tool-names-key tool-urls-key drracket-tool?) (let ([table (with-handlers ((exn:fail? values)) (get-info/full (directory-record-path coll-dir)))]) (cond @@ -104,10 +110,10 @@ string-constants) '(ok stop)) null] [else - (let* ([tools (table 'tools (lambda () null))] - [tool-icons (table 'tool-icons (lambda () (map (lambda (x) #f) tools)))] - [tool-names (table 'tool-names (lambda () (map (lambda (x) #f) tools)))] - [tool-urls (table 'tool-urls (lambda () (map (lambda (x) #f) tools)))]) + (let* ([tools (table tools-key (lambda () null))] + [tool-icons (table tool-icons-key (lambda () (map (lambda (x) #f) tools)))] + [tool-names (table tool-names-key (lambda () (map (lambda (x) #f) tools)))] + [tool-urls (table tool-urls-key (lambda () (map (lambda (x) #f) tools)))]) (unless (= (length tools) (length tool-icons)) (message-box (string-constant drscheme) (format (string-constant tool-tool-icons-same-length) @@ -129,7 +135,7 @@ string-constants) #f '(ok stop)) (set! tool-urls (map (lambda (x) #f) tools))) - (map (lambda (t i n u) (make-installed-tool coll-dir t i n u)) + (map (lambda (t i n u) (make-installed-tool coll-dir t i n u drracket-tool?)) tools tool-icons tool-names tool-urls))]))) ;; candidate-tool? : installed-tool -> boolean @@ -242,19 +248,21 @@ string-constants) (installed-tool-spec it) (installed-tool-bitmap it) (installed-tool-name it) - (installed-tool-url it))) + (installed-tool-url it) + (installed-tool-drracket? it))) ;; load/invoke-tool* : path ;; (listof string[sub-collection-name]) ;; (union #f (cons string[filename] (listof string[collection-name]))) ;; (union #f string) ;; (union #f string) +;; boolean ;; -> void ;; `coll' is a collection to load the tool from ;; `in-path' is the `coll'-relative collection-path spec for the tool module file ;; `icon-spec' is the collection-path spec for the tool's icon, if there is one. ;; `name' is the name of the tool (only used in about box) -(define (load/invoke-tool* coll-dir in-path icon-spec name tool-url) +(define (load/invoke-tool* coll-dir in-path icon-spec name tool-url drracket?) (let* ([icon-path (cond [(string? icon-spec) @@ -297,8 +305,9 @@ string-constants) coll-dir in-path) x))]) (let-values ([(phase1-thunk phase2-thunk) - (drracket:tools-drs:invoke-drs-tool unit (string->symbol (or name (path->string coll-dir)))) - #;(invoke-tool unit (string->symbol (or name (path->string coll-dir))))]) + (if drracket? + (invoke-tool unit (string->symbol (or name (path->string coll-dir)))) + (drracket:tools-drs:invoke-drs-tool unit (string->symbol (or name (path->string coll-dir)))))]) (set! successfully-loaded-tools (cons (make-successfully-loaded-tool tool-path diff --git a/collects/drscheme/syncheck.rkt b/collects/drscheme/syncheck.rkt index 60b7dea3eb..8349f3cd7c 100644 --- a/collects/drscheme/syncheck.rkt +++ b/collects/drscheme/syncheck.rkt @@ -27,7 +27,7 @@ If the namespace does not, they are colored the unbound color. syntax/toplevel syntax/boundmap mrlib/switchable-button - (prefix-in drscheme:arrow: drscheme/arrow) + (prefix-in drracket:arrow: drscheme/arrow) (prefix-in fw: framework/framework) mred framework @@ -83,8 +83,8 @@ If the namespace does not, they are colored the unbound color. (define tool@ (unit - (import drscheme:tool^) - (export drscheme:tool-exports^) + (import drracket:tool^) + (export drracket:tool-exports^) ;; use this to communicate the frame being ;; syntax checked w/out having to add new @@ -92,7 +92,7 @@ If the namespace does not, they are colored the unbound color. (define currently-processing-definitions-text (make-parameter #f)) (define (phase1) - (drscheme:module-language-tools:add-opt-out-toolbar-button + (drracket:module-language-tools:add-opt-out-toolbar-button (λ (frame parent) (new switchable-button% (label (string-constant check-syntax)) @@ -100,7 +100,7 @@ If the namespace does not, they are colored the unbound color. (parent parent) (callback (λ (button) (send frame syncheck:button-callback))))) 'drscheme:syncheck) - (drscheme:unit:add-to-program-editor-mixin clearing-text-mixin)) + (drracket:unit:add-to-program-editor-mixin clearing-text-mixin)) (define (phase2) (void)) (define (printf . args) (apply fprintf o args)) @@ -200,7 +200,7 @@ If the namespace does not, they are colored the unbound color. (define/private (clean-up) (let ([st (find-syncheck-text this)]) (when (and st - (is-a? st drscheme:unit:definitions-text<%>)) + (is-a? st drracket:unit:definitions-text<%>)) (let ([tab (send st get-tab)]) (send tab syncheck:clear-error-message) (send tab syncheck:clear-highlighting))))) @@ -551,7 +551,7 @@ If the namespace does not, they are colored the unbound color. [end-y (arrow-end-y arrow)]) (unless (and (= start-x end-x) (= start-y end-y)) - (drscheme:arrow:draw-arrow dc start-x start-y end-x end-y dx dy) + (drracket:arrow:draw-arrow dc start-x start-y end-x end-y dx dy) (when (and (var-arrow? arrow) (not (var-arrow-actual? arrow))) (let-values ([(fw fh _d _v) (send dc get-text-extent "x")]) (send dc draw-text "?" @@ -968,7 +968,7 @@ If the namespace does not, they are colored the unbound color. (define tab-mixin - (mixin (drscheme:unit:tab<%>) () + (mixin (drracket:unit:tab<%>) () (inherit is-current-tab? get-defs get-frame) (define report-error-text (new (fw:text:ports-mixin fw:scheme:text%))) @@ -1016,7 +1016,7 @@ If the namespace does not, they are colored the unbound color. (super-new))) (define unit-frame-mixin - (mixin (drscheme:unit:frame<%>) (syncheck-frame<%>) + (mixin (drracket:unit:frame<%>) (syncheck-frame<%>) (inherit get-button-panel get-definitions-canvas @@ -1035,8 +1035,8 @@ If the namespace does not, they are colored the unbound color. (define/private (update-button-visibility/tab tab) (update-button-visibility/settings (send (send tab get-defs) get-next-settings))) (define/public (update-button-visibility/settings settings) - (let* ([lang (drscheme:language-configuration:language-settings-language settings)] - [visible? (and (not (is-a? lang drscheme:module-language:module-language<%>)) + (let* ([lang (drracket:language-configuration:language-settings-language settings)] + [visible? (and (not (is-a? lang drracket:module-language:module-language<%>)) (send lang capability-value 'drscheme:check-syntax-button))]) (send check-syntax-button-parent-panel change-children (λ (l) @@ -1193,7 +1193,7 @@ If the namespace does not, they are colored the unbound color. (show-error-report/tab)))) - (drscheme:debug:error-display-handler/stacktrace + (drracket:debug:error-display-handler/stacktrace msg exn '() @@ -1220,8 +1220,8 @@ If the namespace does not, they are colored the unbound color. (send the-tab reset-offer-kill) (send (send the-tab get-defs) syncheck:init-arrows) - (drscheme:eval:expand-program - (drscheme:language:make-text/pos definitions-text 0 (send definitions-text last-position)) + (drracket:eval:expand-program + (drracket:language:make-text/pos definitions-text 0 (send definitions-text last-position)) (send definitions-text get-next-settings) #t init-proc @@ -2547,7 +2547,7 @@ If the namespace does not, they are colored the unbound color. ;; add-to-cleanup-texts : (is-a?/c editor<%>) -> void (define (add-to-cleanup-texts ed) (let ([outermost (find-outermost-editor ed)]) - (and (is-a? outermost drscheme:unit:definitions-text<%>) + (and (is-a? outermost drracket:unit:definitions-text<%>) (send outermost syncheck:add-to-cleanup-texts ed)))) (define (find-outermost-editor ed) @@ -2886,10 +2886,10 @@ If the namespace does not, they are colored the unbound color. ; ; - (add-check-syntax-key-bindings (drscheme:rep:get-drs-bindings-keymap)) + (add-check-syntax-key-bindings (drracket:rep:get-drs-bindings-keymap)) (fw:color-prefs:add-to-preferences-panel (string-constant check-syntax) syncheck-add-to-preferences-panel) - (drscheme:language:register-capability 'drscheme:check-syntax-button (flat-contract boolean?) #t) - (drscheme:get/extend:extend-definitions-text make-syncheck-text%) - (drscheme:get/extend:extend-unit-frame unit-frame-mixin #f) - (drscheme:get/extend:extend-tab tab-mixin))) + (drracket:language:register-capability 'drscheme:check-syntax-button (flat-contract boolean?) #t) + (drracket:get/extend:extend-definitions-text make-syncheck-text%) + (drracket:get/extend:extend-unit-frame unit-frame-mixin #f) + (drracket:get/extend:extend-tab tab-mixin))) diff --git a/collects/drscheme/tool-lib.rkt b/collects/drscheme/tool-lib.rkt index 1d969f92a3..6352123c6f 100644 --- a/collects/drscheme/tool-lib.rkt +++ b/collects/drscheme/tool-lib.rkt @@ -2,8 +2,8 @@ #| -This first time this is loaded, it loads all of drscheme and invokes -the main unit, starting up drscheme. After that, it just provides +This first time this is loaded, it loads all of DrRacket and invokes +the main unit, starting up DrRacket. After that, it just provides all of the names in the tools library, for use defining keybindings |# @@ -13,19 +13,19 @@ all of the names in the tools library, for use defining keybindings racket/contract racket/class - drscheme/private/link - drscheme/private/drsig + "private/link.rkt" + "private/drsig.rkt" framework framework/splash mrlib/switchable-button scribble/srcdoc - drscheme/private/language-object-contract) + "private/language-object-contract.rkt") (require (for-syntax scheme/base)) -(require/doc drscheme/private/ts scheme/base scribble/manual) +(require/doc "private/ts.rkt" scheme/base scribble/manual) (require/doc (for-label errortrace/errortrace-key scheme/pretty @@ -53,15 +53,15 @@ all of the names in the tools library, for use defining keybindings symbol? void?) (make-button id) - @{Call this function to add another button to DrScheme's toolbar. When buttons are added this way, - DrScheme monitors the @tt{#lang} line at the top of the file; when it changes DrScheme queries + @{Call this function to add another button to DrRacket's toolbar. When buttons are added this way, + DrRacket monitors the @tt{#lang} line at the top of the file; when it changes DrRacket queries the language to see if this button should be included. These buttons are ``opt out'', meaning that if the language doesn't explicitly ask to not have this button (or all such buttons), the button will appear. @section-index["drscheme:opt-out-toolbar-buttons"] See @racket[read-language] for more details on how language's specify how to opt out. - DrScheme will invoke the @tt{get-info} proc from @racket[read-language] with + DrRacket will invoke the @tt{get-info} proc from @racket[read-language] with @tt{'drscheme:opt-out-toolbar-buttons}. If the result is a list of symbols, the listed symbols are opted out. If the result is @racket[#f], all buttons are opted out. The default is the empty list, meaning that all opt-out buttons appear.. @@ -71,7 +71,7 @@ all of the names in the tools library, for use defining keybindings drracket:module-language:add-module-language (-> any) () - @{Adds the module language to DrScheme. This is called during DrScheme's startup.}) + @{Adds the module language to DrRacket. This is called during DrRacket's startup.}) (proc-doc/names drracket:module-language:module-language-put-file-mixin @@ -112,7 +112,7 @@ all of the names in the tools library, for use defining keybindings @item{ @racket[current-namespace] has been set to a newly created empty namespace. This namespace has the following modules copied (with @racket[namespace-attach-module]) - from DrScheme's original namespace: + from DrRacket's original namespace: @itemize[@item{@racket['mzscheme]}@item{@racket['mred]}] }@item{ @racket[read-curly-brace-as-paren] @@ -131,7 +131,7 @@ all of the names in the tools library, for use defining keybindings a parameter that kills the user's custodian. }@item{ The snip-class-list, returned by @racket[get-the-snip-class-list] - is initialized with all of the snipclasses in DrScheme's eventspace's snip-class-list. + is initialized with all of the snipclasses in DrRacket's eventspace's snip-class-list. }]}) @@ -286,7 +286,7 @@ all of the names in the tools library, for use defining keybindings @racket[drracket:language-configuration:make-language-settings] for details on that structure. - If the program is associated with a DrScheme + If the program is associated with a DrRacket frame, get the frame's language settings from the @method[drracket:unit:definitions-text<%> get-next-settings] method of @@ -345,7 +345,7 @@ all of the names in the tools library, for use defining keybindings (defs #f) (ints #f))) @{Displays the error message represented by the string, adding - embellishments like those that appears in the DrScheme REPL, + embellishments like those that appears in the DrRacket REPL, specifically a clickable icon for the stack trace (if the srcloc location is not empty), 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). @@ -373,7 +373,7 @@ all of the names in the tools library, for use defining keybindings parameter. If the current-error-port is the definitions window in - drscheme, this error handler inserts some debugging + DrRacket, this error handler inserts some debugging annotations, calls @racket[oedh], and then highlights the source location of the runtime error. @@ -408,7 +408,7 @@ all of the names in the tools library, for use defining keybindings void?) ((debug-info) ((edition-pair #f))) - @{This function opens a DrScheme to display + @{This function opens a DrRacket to display @racket[debug-info]. Only the src the position and the span fields of the srcloc are considered. @@ -434,7 +434,7 @@ all of the names in the tools library, for use defining keybindings void?) (error-message dis editions-pairs defs ints) @{Shows the backtrace window you get when clicking on the bug in - DrScheme's REPL. + DrRacket's REPL. The @racket[error-message] argument is the text of the error, @racket[dis] is the debug information, extracted from the @@ -446,7 +446,7 @@ all of the names in the tools library, for use defining keybindings The @racket[defs] argument should be non-@racket[#f] if there are possibly stacktrace frames that contain unsaved versions of the - definitions window from drscheme. Similarly, the @racket[ints] argument + definitions window from DrRacket. Similarly, the @racket[ints] argument should be non-@racket[#f] if there are possibly stacktrace frames that contain unsaved versions of the interactions window. @@ -468,7 +468,7 @@ all of the names in the tools library, for use defining keybindings ((rep #f) (defs #f))) @{Shows the backtrace window you get when clicking on the bug in - DrScheme's REPL. + DrRacket's REPL. This function simply calls @racket[drracket:debug:show-backtrace-window/edition-pairs], using @racket[drracket:debug:srcloc->edition/pair]. @@ -575,7 +575,7 @@ all of the names in the tools library, for use defining keybindings ((or/c string? false/c) . -> . (is-a?/c drracket:unit:frame%))) (() (filename)) - @{Opens a drscheme frame that displays @racket[filename], + @{Opens a DrRacket frame that displays @racket[filename], or nothing if @racket[filename] is @racket[#f] or not supplied.}) @@ -607,11 +607,11 @@ all of the names in the tools library, for use defining keybindings . -> . drracket:modes:mode?) (name surrogate repl-submit matches-language) - @{Adds a mode to DrScheme. Returns a mode value + @{Adds a mode to DrRacket. Returns a mode value that identifies the mode. The first argument, @racket[name], is the name - of the mode, used in DrScheme's GUI to allow + of the mode, used in DrRacket's GUI to allow the user to select this mode. The @racket[surrogate] argument is set to the @@ -656,7 +656,7 @@ all of the names in the tools library, for use defining keybindings drracket:modes:get-modes (-> (listof drracket:modes:mode?)) () - @{Returns all of the modes currently added to DrScheme. + @{Returns all of the modes currently added to DrRacket. See also @racket[drracket:modes:add-mode].}) @@ -734,7 +734,7 @@ all of the names in the tools library, for use defining keybindings drracket:rep:get-drs-bindings-keymap (-> (is-a?/c keymap%)) () - @{Returns a keymap that binds various DrScheme-specific + @{Returns a keymap that binds various DrRacket-specific keybindings. This keymap is used in the definitions and interactions window. @@ -790,7 +790,7 @@ all of the names in the tools library, for use defining keybindings ((make-mixin-contract drracket:unit:tab<%>) boolean? . -> . void?)) ((mixin) (mixin before?)) - @{This class implements the tabs in drscheme. One is created for each tab + @{This class implements the tabs in DrRacket. One is created for each tab in a frame (each frame always has at least one tab, even if the tab bar is not shown) The argument, @racket[before], controls if the mixin is applied before or @@ -804,7 +804,7 @@ all of the names in the tools library, for use defining keybindings ((make-mixin-contract drracket:rep:text<%>) boolean? . -> . void?)) ((mixin) (mixin before?)) - @{This text is used in the bottom window of drscheme frames. + @{This text is used in the bottom window of DrRacket frames. The argument, @racket[before], controls if the mixin is applied before or after already installed mixins. @@ -826,7 +826,7 @@ all of the names in the tools library, for use defining keybindings ((make-mixin-contract drracket:unit:definitions-text<%>) boolean? . -> . void?)) ((mixin) (mixin before?)) - @{This text is used in the top window of drscheme frames. + @{This text is used in the top window of DrRacket frames. The argument, @racket[before], controls if the mixin is applied before or after already installed mixins. @@ -848,7 +848,7 @@ all of the names in the tools library, for use defining keybindings ((make-mixin-contract drracket:unit:interactions-canvas%) boolean? . -> . void?)) ((mixin) (mixin before?)) - @{This canvas is used in the bottom window of drscheme frames. + @{This canvas is used in the bottom window of DrRacket frames. The argument, @racket[before], controls if the mixin is applied before or after already installed mixins. @@ -870,7 +870,7 @@ all of the names in the tools library, for use defining keybindings ((make-mixin-contract drracket:unit:definitions-canvas%) boolean? . -> . void?)) ((mixin) (mixin before?)) - @{This canvas is used in the top window of drscheme frames. + @{This canvas is used in the top window of DrRacket frames. The argument, @racket[before], controls if the mixin is applied before or after already installed mixins. @@ -892,7 +892,7 @@ all of the names in the tools library, for use defining keybindings ((make-mixin-contract drracket:unit:frame%) boolean? . -> . void?)) ((mixin) (mixin before?)) - @{This is the frame that implements the main drscheme window. + @{This is the frame that implements the main DrRacket window. The argument, @racket[before], controls if the mixin is applied before or after already installed mixins. @@ -932,7 +932,7 @@ all of the names in the tools library, for use defining keybindings (-> syntax? syntax?) (stx) @{Call this function to add tracing annotations to the a fully-expanded - expression. When the program runs, DrScheme will pop open the tracing + expression. When the program runs, DrRacket will pop open the tracing window to display the trace.}) ; @@ -974,7 +974,7 @@ all of the names in the tools library, for use defining keybindings () @{This can only be called after all of the tools initialization phases have completed. - Returns the list of all of the languages installed in DrScheme.}) + Returns the list of all of the languages installed in DrRacket.}) (proc-doc/names drracket:language-configuration:add-language @@ -984,7 +984,7 @@ all of the names in the tools library, for use defining keybindings @{@phase[2] - Adds @racket[language] to the languages offerend by DrScheme.}) + Adds @racket[language] to the languages offerend by DrRacket.}) (proc-doc/names drracket:language-configuration:get-settings-preferences-symbol @@ -1051,7 +1051,7 @@ all of the names in the tools library, for use defining keybindings @racket[drracket:language-configuration:fill-language-dialog]. The @racket[show-welcome?] argument determines if - if a ``Welcome to DrScheme'' message and some + if a ``Welcome to DrRacket'' message and some natural language buttons are shown. The @racket[language-settings-to-show] argument @@ -1116,7 +1116,7 @@ all of the names in the tools library, for use defining keybindings @{Registers a new capability with a default value for each language and a contract on the values the capability might have. - By default, these capabilities are registered as DrScheme starts up: + By default, these capabilities are registered as DrRacket starts up: @(let-syntax ([cap (syntax-rules () [(cap key contract default desc ...) (item @racket['key : contract = default]