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

added 'module' wrapper for saved files in the teaching languages (and support for that in the drscheme:language:language<%> interface)

Browse Source 
svn: r5602
This commit is contained in:
Robby Findler 2007-02-14 23:23:32 +00:00
parent 94c1702b56
commit e3776e5476
10 changed files with 121 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/algol60/tool.ss
View File

@ -49,6 +49,7 @@
(define lang%
(class* object% (drscheme:language:language<%>)
(define/public (get-save-module) #f)
(define/public (capability-value s) (drscheme:language:get-capability-default s))
(define/public (first-opened) (void))
(define/public (config-panel parent)

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

@ -1379,10 +1379,9 @@
(let* ([extras-mixin
(λ (mred-launcher? one-line-summary)
(λ (%)
(class %
(class* % (drscheme:language:language<%>)
(define/override (get-one-line-summary) one-line-summary)
(define/override (use-namespace-require/copy?) #t)
(inherit get-module get-transformer-module get-init-code)
(define/override (create-executable setting parent program-filename teachpacks)
(let ([executable-fn
@ -1403,7 +1402,7 @@
(get-init-code setting teachpacks)
mred-launcher?
(use-namespace-require/copy?)))))
(super-instantiate ()))))]
(super-new))))]
[make-simple
(λ (module id position numbers mred-launcher? one-line-summary extra-mixin)
(let ([%

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

@ -34,34 +34,35 @@
;; text/pos = (make-text/pos (instanceof text% number number))
;; this represents a portion of a text to be processed.
(define language<%>
(interface ()
marshall-settings
unmarshall-settings
default-settings
default-settings?
order-manuals
front-end/complete-program
front-end/interaction
config-panel
on-execute
first-opened
render-value/format
render-value
capability-value
create-executable
get-language-position
get-language-name
get-style-delta
get-language-numbers
get-one-line-summary
get-language-url
get-comment-character))
(define language<%>
(interface ()
marshall-settings
unmarshall-settings
default-settings
default-settings?
order-manuals
front-end/complete-program
front-end/interaction
config-panel
on-execute
first-opened
render-value/format
render-value
capability-value
create-executable
get-save-module
get-language-position
get-language-name
get-style-delta
get-language-numbers
get-one-line-summary
get-language-url
get-comment-character))
(define module-based-language<%>
(interface ()
@ -508,6 +509,8 @@
(inherit get-module get-transformer-module use-namespace-require/copy?
get-init-code use-mred-launcher get-reader)
(define/public (get-save-module) #f)
(define/pubment (capability-value s)
(inner (get-capability-default s) capability-value s))

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

@ -45,7 +45,7 @@
;; module-mixin : (implements drscheme:language:language<%>)
;; -> (implements drscheme:language:language<%>)
(define (module-mixin %)
(class* % (module-language<%>)
(class* % (drscheme:language:language<%> module-language<%>)
(define/override (use-namespace-require/copy?) #t)
(field [iteration-number 0])

76
collects/drscheme/private/unit.ss
View File

@ -359,7 +359,7 @@ module browser threading seems wrong.
;
;
(define get-definitions-text%
(let ([definitions-text% #f])
(λ ()
@ -420,6 +420,23 @@ module browser threading seems wrong.
(set-current-mode mode))
(loop (cdr modes))))]))))
(inherit begin-edit-sequence end-edit-sequence
delete insert last-position paragraph-start-position
get-character)
(define/augment (on-save-file filename fmt)
(inner (void) on-save-file filename fmt)
(let ([name-mod (send (drscheme:language-configuration:language-settings-language next-settings)
get-save-module)])
(when name-mod
(begin-edit-sequence)
(let-values ([(base name dir) (split-path filename)])
(insert (format "(module ~s ~s\n"
(string->symbol (regexp-replace #rx"\\.[^.]*$"
(path->string name)
""))
name-mod)
0 0))
(insert ")" (last-position) (last-position)))))
(define/augment (after-save-file success?)
(when success?
(let ([filename (get-filename)])
@ -429,8 +446,56 @@ module browser threading seems wrong.
(with-handlers ([exn:fail:filesystem? void])
(let-values ([(creator type) (file-creator-and-type filename)])
(file-creator-and-type filename #"DrSc" type))))))
(let ([name-mod (send (drscheme:language-configuration:language-settings-language next-settings)
get-save-module)])
(when name-mod
(delete (- (last-position) 1) (last-position))
(delete (paragraph-start-position 0)
(paragraph-start-position 1))
(end-edit-sequence)
(set-modified #f)))
(inner (void) after-save-file success?))
(define/augment (on-load-file filename format)
(inner (void) on-load-file filename format)
(begin-edit-sequence))
(define/augment (after-load-file success?)
(when success?
(let* ([tp (open-input-text-editor this)]
[l (read-line tp)])
(unless (eof-object? l)
(unless (regexp-match #rx"[;#]" l) ;; no comments on the first line
(when (equal? #\) (get-character (- (last-position) 1)))
(let ([sp (open-input-string l)])
(when (regexp-match #rx"[(]" sp)
(let/ec k
(let-values ([(mod name module-spec)
(with-handlers ([exn:fail:read? (λ (x) (k (void)))])
(values (read sp)
(read sp)
(read sp)))])
(when (eq? mod 'module)
(let ([matching-language
(ormap
(λ (lang)
(and (equal? module-spec (send lang get-save-module))
lang))
(drscheme:language-configuration:get-languages))])
(delete (- (last-position) 1) (last-position))
(delete (paragraph-start-position 0)
(paragraph-start-position 1))
(when matching-language
(unless (eq? (drscheme:language-configuration:language-settings-language
next-settings)
matching-language)
(set-next-settings
(drscheme:language-configuration:make-language-settings
matching-language
(send matching-language default-settings)))))
(set-modified #f))))))))))))
(end-edit-sequence)
(inner (void) after-load-file success?))
(inherit is-modified? run-after-edit-sequence)
(define/override (set-modified mod?)
(super set-modified mod?)
@ -458,12 +523,17 @@ module browser threading seems wrong.
(define/pubment (get-next-settings) next-settings)
(define/pubment (set-next-settings _next-settings)
(when (or (send (drscheme:language-configuration:language-settings-language _next-settings)
get-save-module)
(send (drscheme:language-configuration:language-settings-language next-settings)
get-save-module))
(set-modified #t))
(set! next-settings _next-settings)
(change-mode-to-match)
(after-set-next-settings _next-settings))
(define/pubment (after-set-next-settings s)
(inner (void) after-set-next-settings s))
(inner (void) after-set-next-settings s))
(define/public (needs-execution)
(or needs-execution-state

4
collects/lang/htdp-langs.ss
View File

@ -450,7 +450,9 @@ tracing todo:
[else (inner (drscheme:language:get-capability-default key)
capability-value
key)]))
(define/override (get-save-module) (get-module))
(super-new)))
(define (stepper-settings-language %)

4
collects/macro-debugger/tool.ss
View File

@ -101,7 +101,9 @@
(class %
(inherit get-top-level-window)
(define/augment (after-set-next-settings s)
(send (get-top-level-window) check-language)
(let ([tlw (get-top-level-window)])
(when tlw
(send tlw check-language)))
(inner (void) after-set-next-settings s))
(super-new)))

4
collects/mztake/debug-tool.ss
View File

@ -436,7 +436,9 @@
(loop start-pos (rest marks)))))))))
(define/augment (after-set-next-settings s)
(send (get-top-level-window) check-current-language-for-debugger)
(let ([tlw (get-top-level-window)])
(when tlw
(send tlw check-current-language-for-debugger)))
(inner (void) after-set-next-settings s))))
(define (debug-interactions-text-mixin super%)

2
collects/profj/tool.ss
View File

@ -150,7 +150,7 @@
(define (java-lang-mixin level name number one-line dyn?)
(when dyn? (dynamic? #t))
(class* object% (drscheme:language:language<%>)
(define/public (get-save-module) #f)
(define/public (capability-value s)
(cond
[(eq? s 'drscheme:language-menu-title) (string-constant profj-java)]

4
collects/stepper/stepper-tool.ss
View File

@ -635,7 +635,9 @@
(inner (void) on-delete x y))
(define/augment (after-set-next-settings s)
(send (get-top-level-window) check-current-language-for-stepper)
(let ([tlw (get-top-level-window)])
(when tlw
(send tlw check-current-language-for-stepper)))
(inner (void) after-set-next-settings s))
(super-new)))