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

improved not-a-language language

Browse Source 
svn: r1241
This commit is contained in:
Robby Findler 2005-11-06 20:55:39 +00:00
parent 2fe1e5fc49
commit 40517379bd
7 changed files with 150 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/algol60/tool.ss
View File

@ -47,6 +47,7 @@
(define lang%
(class* object% (drscheme:language:language<%>)
(define/public (first-opened) (void))
(define/public (config-panel parent)
(case-lambda
[() null]

42
collects/drscheme/private/language-configuration.ss
View File

@ -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

2
collects/drscheme/private/language.ss
View File

@ -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))

200
collects/drscheme/private/rep.ss
View File

@ -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)

1
collects/honu/tool.ss
View File

@ -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)

1
collects/profj/tool.ss
View File

@ -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"))

14
collects/string-constants/english-string-constants.ss
View File

@ -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")