diff --git a/collects/algol60/tool.ss b/collects/algol60/tool.ss index ab14959400..b97aac49b6 100644 --- a/collects/algol60/tool.ss +++ b/collects/algol60/tool.ss @@ -47,6 +47,7 @@ (define lang% (class* object% (drscheme:language:language<%>) + (define/public (first-opened) (void)) (define/public (config-panel parent) (case-lambda [() null] diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss index 4f0eff80f1..5a143105f3 100644 --- a/collects/drscheme/private/language-configuration.ss +++ b/collects/drscheme/private/language-configuration.ss @@ -1380,16 +1380,24 @@ not-a-language-extra-mixin)))) (define (not-a-language-extra-mixin %) - (class % + (class* % (not-a-language-language<%>) (define/override (get-style-delta) drscheme:rep:error-delta) + (define/override (first-opened) + (not-a-language-message) + (fprintf (current-error-port) "\n")) + (define/override (front-end/interaction input settings teachpack-cache) (not-a-language-message) (λ () eof)) (define/override (front-end/complete-program input settings teachpack-cache) (not-a-language-message) (λ () eof)) - (super-new))) + (super-new))) + + ;; used for identification only + (define not-a-language-language<%> + (interface ())) ; @@ -1410,14 +1418,28 @@ (define (not-a-language-message) (define (main) - (o (string-constant must-choose-language)) - (o "\n") - (o "Either select the \"Choose Language...\" item in the \"Language\" menu, or ") - (o (new link-snip% - [words "get guidance"] - [callback (lambda (snip) - (not-a-language-dialog (find-parent-from-snip snip)))])) - (o ".")) + (when (language-still-unchanged?) + (o (string-constant must-choose-language)) + (o "\n") + (o (string-constant get-guidance-before)) + (o (new link-snip% + [words (string-constant get-guidance-during)] + [callback (lambda (snip) + (not-a-language-dialog (find-parent-from-snip snip)))])) + (o (string-constant get-guidance-after)))) + + (define (language-still-unchanged?) + (let ([rep (drscheme:rep:current-rep)]) + (cond + [rep + (let* ([next-settings (send (send rep get-definitions-text) get-next-settings)] + [next-lang (language-settings-language next-settings)]) + (is-a? next-lang not-a-language-language<%>))] + + ;; if we cannot get the REP + ;; (because a tool is processing the progrm like check syntax) + ;; then just assume it has not changed. + [else #t]))) (define o (case-lambda diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss index fa30e34767..307fc7d50c 100644 --- a/collects/drscheme/private/language.ss +++ b/collects/drscheme/private/language.ss @@ -49,6 +49,7 @@ front-end/interaction config-panel on-execute + first-opened render-value/format render-value @@ -502,6 +503,7 @@ (inherit get-module get-transformer-module use-namespace-require/copy? get-init-code use-mred-launcher get-reader) + (define/public (first-opened) (void)) (define/public (get-comment-character) (values "; " #\;)) (define/public (order-manuals x) (values x #t)) diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index 56b0826ca1..78dae204d0 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -1073,103 +1073,103 @@ TODO (semaphore-post eval-thread-state-sema) (semaphore-post eval-thread-queue-sema)) - (define/private init-evaluation-thread ; =Kernel= - (λ () - (set! user-language-settings (send definitions-text get-next-settings)) + (define/private (init-evaluation-thread) ; =Kernel= + (set! user-language-settings (send definitions-text get-next-settings)) + + (set! user-custodian (make-custodian)) + ; (custodian-limit-memory user-custodian 10000000 user-custodian) + (set! user-eventspace-box (make-weak-box + (parameterize ([current-custodian user-custodian]) + (make-eventspace)))) + (set! user-break-parameterization (parameterize-break + #t + (current-break-parameterization))) + (set! user-break-enabled #t) + (set! eval-thread-thunks null) + (set! eval-thread-state-sema (make-semaphore 1)) + (set! eval-thread-queue-sema (make-semaphore 0)) + + (let* ([init-thread-complete (make-semaphore 0)] + [goahead (make-semaphore)]) - (set! user-custodian (make-custodian)) - ; (custodian-limit-memory user-custodian 10000000 user-custodian) - (set! user-eventspace-box (make-weak-box - (parameterize ([current-custodian user-custodian]) - (make-eventspace)))) - (set! user-break-parameterization (parameterize-break - #t - (current-break-parameterization))) - (set! user-break-enabled #t) - (set! eval-thread-thunks null) - (set! eval-thread-state-sema (make-semaphore 1)) - (set! eval-thread-queue-sema (make-semaphore 0)) - - (let* ([init-thread-complete (make-semaphore 0)] - [goahead (make-semaphore)] - [queue-user/wait - (λ (thnk) - (let ([wait (make-semaphore 0)]) - (parameterize ([current-eventspace (get-user-eventspace)]) - (queue-callback - (λ () - (thnk) - (semaphore-post wait)))) - (semaphore-wait wait)))]) - - ; setup standard parameters - (let ([snip-classes - ; the snip-classes in the DrScheme eventspace's snip-class-list - (drscheme:eval:get-snip-classes)]) - (queue-user/wait - (λ () ; =User=, =No-Breaks= - ; No user code has been evaluated yet, so we're in the clear... - (break-enabled #f) - (set! user-thread-box (make-weak-box (current-thread))) - (initialize-parameters snip-classes)))) - - ;; disable breaks until an evaluation actually occurs - (send context set-breakables #f #f) - - ;; initialize the language - (send (drscheme:language-configuration:language-settings-language user-language-settings) - on-execute - (drscheme:language-configuration:language-settings-settings user-language-settings) - queue-user/wait) - - ;; installs the teachpacks - ;; must happen after language is initialized. + ; setup standard parameters + (let ([snip-classes + ; the snip-classes in the DrScheme eventspace's snip-class-list + (drscheme:eval:get-snip-classes)]) (queue-user/wait (λ () ; =User=, =No-Breaks= - (drscheme:teachpack:install-teachpacks - user-teachpack-cache))) - - (parameterize ([current-eventspace (get-user-eventspace)]) - (queue-callback - (λ () - (let ([drscheme-error-escape-handler - (λ () - ((current-error-escape-k)))]) - (error-escape-handler drscheme-error-escape-handler)) - - (set! in-evaluation? #f) - (update-running #f) - (send context set-breakables #f #f) - - ;; let init-thread procedure return, - ;; now that parameters are set - (semaphore-post init-thread-complete) - - ; We're about to start running user code. - - ; Pause to let killed-thread get initialized - (semaphore-wait goahead) - - (let loop () ; =User=, =Handler=, =No-Breaks= - ; Wait for something to do - (unless (semaphore-try-wait? eval-thread-queue-sema) - ; User event callbacks run here; we turn on - ; breaks in the dispatch handler. - (yield eval-thread-queue-sema)) - ; About to eval something - (semaphore-wait eval-thread-state-sema) - (let ([thunk (car eval-thread-thunks)]) - (set! eval-thread-thunks (cdr eval-thread-thunks)) - (semaphore-post eval-thread-state-sema) - ; This thunk evals the user's expressions with appropriate - ; protections. - (thunk)) - (loop))))) - (semaphore-wait init-thread-complete) - ; Start killed-thread - (initialize-killed-thread) - ; Let user expressions go... - (semaphore-post goahead)))) + ; No user code has been evaluated yet, so we're in the clear... + (break-enabled #f) + (set! user-thread-box (make-weak-box (current-thread))) + (initialize-parameters snip-classes)))) + + ;; disable breaks until an evaluation actually occurs + (send context set-breakables #f #f) + + ;; initialize the language + (send (drscheme:language-configuration:language-settings-language user-language-settings) + on-execute + (drscheme:language-configuration:language-settings-settings user-language-settings) + (let ([run-on-user-thread (lambda (t) (queue-user/wait t))]) + run-on-user-thread)) + + ;; installs the teachpacks + ;; must happen after language is initialized. + (queue-user/wait + (λ () ; =User=, =No-Breaks= + (drscheme:teachpack:install-teachpacks + user-teachpack-cache))) + + (parameterize ([current-eventspace (get-user-eventspace)]) + (queue-callback + (λ () + (let ([drscheme-error-escape-handler + (λ () + ((current-error-escape-k)))]) + (error-escape-handler drscheme-error-escape-handler)) + + (set! in-evaluation? #f) + (update-running #f) + (send context set-breakables #f #f) + + ;; let init-thread procedure return, + ;; now that parameters are set + (semaphore-post init-thread-complete) + + ; We're about to start running user code. + + ; Pause to let killed-thread get initialized + (semaphore-wait goahead) + + (let loop () ; =User=, =Handler=, =No-Breaks= + ; Wait for something to do + (unless (semaphore-try-wait? eval-thread-queue-sema) + ; User event callbacks run here; we turn on + ; breaks in the dispatch handler. + (yield eval-thread-queue-sema)) + ; About to eval something + (semaphore-wait eval-thread-state-sema) + (let ([thunk (car eval-thread-thunks)]) + (set! eval-thread-thunks (cdr eval-thread-thunks)) + (semaphore-post eval-thread-state-sema) + ; This thunk evals the user's expressions with appropriate + ; protections. + (thunk)) + (loop))))) + (semaphore-wait init-thread-complete) + ; Start killed-thread + (initialize-killed-thread) + ; Let user expressions go... + (semaphore-post goahead))) + + (define/private (queue-user/wait thnk) + (let ([wait (make-semaphore 0)]) + (parameterize ([current-eventspace (get-user-eventspace)]) + (queue-callback + (λ () + (thnk) + (semaphore-post wait)))) + (semaphore-wait wait))) (field (shutting-down? #f)) @@ -1319,6 +1319,12 @@ TODO ; =User=, =Non-Handler=, =No-Breaks= (primitive-dispatch-handler eventspace)]))))))) + (define/public (new-empty-console) + (queue-user/wait + (λ () ; =User=, =No-Breaks= + (send (drscheme:language-configuration:language-settings-language user-language-settings) + first-opened)))) + (define/public (reset-console) (when (thread? thread-killed) (kill-thread thread-killed)) @@ -1402,6 +1408,12 @@ TODO (thaw-colorer) (send context disable-evaluation) (reset-console) + + (queue-user/wait + (λ () ; =User=, =No-Breaks= + (send (drscheme:language-configuration:language-settings-language user-language-settings) + first-opened))) + (insert-prompt) (send context enable-evaluation) (end-edit-sequence) diff --git a/collects/honu/tool.ss b/collects/honu/tool.ss index 86fcfad923..92c8ae7401 100644 --- a/collects/honu/tool.ss +++ b/collects/honu/tool.ss @@ -29,6 +29,7 @@ (define (honu-lang-mixin level) (class* object% (drscheme:language:language<%>) + (define/public (first-opened) (void)) (define/public (get-comment-character) (values "//" #\*)) (define/public (default-settings) diff --git a/collects/profj/tool.ss b/collects/profj/tool.ss index a7d608715d..f465118370 100644 --- a/collects/profj/tool.ss +++ b/collects/profj/tool.ss @@ -132,6 +132,7 @@ (define (java-lang-mixin level name number one-line dyn?) (when dyn? (dynamic? #t)) (class* object% (drscheme:language:language<%>) + (define/public (first-opened) (void)) (define/public (order-manuals x) (let* ((beg-list '(#"profj-beginner" #"tour" #"drscheme" #"help")) diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss index f90b4c1643..9b3ee5ddc8 100644 --- a/collects/string-constants/english-string-constants.ss +++ b/collects/string-constants/english-string-constants.ss @@ -1006,13 +1006,13 @@ please adhere to these guidelines: (seasoned-plt-schemer? "Seasoned PLT Schemer?") (looking-for-standard-scheme? "Looking for standard Scheme?") - - ; some of these belong ... - ;(otherwise-use-before "Otherwise, use ") - ;(otherwise-use-between ",\nor choose for yourself from the ") - ;(otherwise-use-language-dialog "language dialog") ; this one will become clickable and will open the language dialog - ;(otherwise-use-after ".") - + + ; the three string constants are concatenated together and the middle + ; one is hyperlinked to the dialog that suggests various languages + (get-guidance-before "Either select the “Choose Language...” item in the “Language” menu, or ") + (get-guidance-during "get guidance") + (get-guidance-after ".") + ;;; debug language (unknown-debug-frame "[unknown]") (backtrace-window-title "Backtrace - DrScheme")