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

fix language positions, misc improvements

Browse Source 
svn: r4085
This commit is contained in:
Eli Barzilay 2006-08-17 20:21:12 +00:00
parent bc9f5abc34
commit b26c6fb351
1 changed files with 36 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
collects/swindle/tool.ss
View File

@ -12,21 +12,19 @@
(provide tool@) (provide tool@)
(define tool@ (define tool@
(unit/sig drscheme:tool-exports^ (import drscheme:tool^) (unit/sig drscheme:tool-exports^ (import drscheme:tool^)
(define swindle-url "http://www.barzilay.org/Swindle/")
;; Swindle languages ;; Swindle languages
(define (swindle-language (define (swindle-language module* name* entry-name* num* one-line* url*)
l-name l-module l-entry-name l-one-line l-sensitive? l-url l-num)
(class (drscheme:language:module-based-language->language-mixin (class (drscheme:language:module-based-language->language-mixin
(drscheme:language:simple-module-based-language->module-based-language-mixin (drscheme:language:simple-module-based-language->module-based-language-mixin
(class* object% (class* object%
(drscheme:language:simple-module-based-language<%>) (drscheme:language:simple-module-based-language<%>)
(define/public (get-language-numbers) `(-1000 2000 ,l-num)) (define/public (get-language-numbers) `(-1000 2000 ,num*))
(define/public (get-language-position) (define/public (get-language-position)
(list (string-constant professional-languages) (list (string-constant professional-languages)
"Swindle" l-entry-name)) "Swindle" entry-name*))
(define/public (get-module) l-module) (define/public (get-module) module*)
(define/public (get-one-line-summary) l-one-line) (define/public (get-one-line-summary) one-line*)
(define/public (get-language-url) l-url) (define/public (get-language-url) url*)
(define/public (get-reader) (define/public (get-reader)
(lambda (src port) (lambda (src port)
(let ([v (read-syntax src port)]) (let ([v (read-syntax src port)])
@ -37,8 +35,8 @@
(define/override (use-namespace-require/copy?) #t) (define/override (use-namespace-require/copy?) #t)
(define/override (default-settings) (define/override (default-settings)
(drscheme:language:make-simple-settings (drscheme:language:make-simple-settings
l-sensitive? 'current-print 'mixed-fraction-e #f #t 'debug)) #t 'current-print 'mixed-fraction-e #f #t 'debug))
(define/override (get-language-name) l-name) (define/override (get-language-name) name*)
(define/override (config-panel parent) (define/override (config-panel parent)
(let* ([make-panel (let* ([make-panel
(lambda (msg contents) (lambda (msg contents)
@ -66,14 +64,12 @@
(make-object message% (format "Swindle") p) (make-object message% (format "Swindle") p)
(make-object message% (format "Setup") p) (make-object message% (format "Setup") p)
p)] p)]
[input [input-sensitive?
(make-panel (string-constant input-syntax) (make-panel (string-constant input-syntax)
(if l-sensitive?
"always case-sensitive"
(lambda (p) (lambda (p)
(make-object check-box% (make-object check-box%
(string-constant case-sensitive-label) (string-constant case-sensitive-label)
p void))))] p void)))]
[debugging [debugging
(make-panel (make-panel
(string-constant dynamic-properties) (string-constant dynamic-properties)
@ -92,17 +88,16 @@
(case-lambda (case-lambda
[() [()
(drscheme:language:make-simple-settings (drscheme:language:make-simple-settings
(or l-sensitive? (send input get-value)) (send input-sensitive? get-value)
'current-print 'mixed-fraction-e #f #t 'current-print 'mixed-fraction-e #f #t
(case (send debugging get-selection) (case (send debugging get-selection)
[(0) 'none] [(0) 'none]
[(1) 'debug] [(1) 'debug]
[(2) 'debug/profile]))] [(2) 'debug/profile]))]
[(settings) [(settings)
(unless l-sensitive? (send input-sensitive? set-value
(send input set-value
(drscheme:language:simple-settings-case-sensitive (drscheme:language:simple-settings-case-sensitive
settings))) settings))
(send debugging set-selection (send debugging set-selection
(case (drscheme:language:simple-settings-annotations (case (drscheme:language:simple-settings-annotations
settings) settings)
@ -114,28 +109,26 @@
[current-inspector (make-inspector)]) [current-inspector (make-inspector)])
((current-print) value))) ((current-print) value)))
(super-instantiate ()))) (super-instantiate ())))
(define (add-swindle-language (define (add-swindle-language name module entry-name num one-line url)
name module entry-name one-line sensitive? url num)
(drscheme:language-configuration:add-language (drscheme:language-configuration:add-language
(make-object ((drscheme:language:get-default-mixin) (make-object
(swindle-language ((drscheme:language:get-default-mixin)
name (swindle-language `(lib ,(string-append module ".ss") "swindle")
`(lib ,(string-append module ".ss") "swindle") name entry-name num one-line url)))))
entry-name one-line sensitive? url
num)))))
(define phase1 void) (define phase1 void)
(define (phase2) (define (phase2)
(for-each (lambda (args) (for-each (lambda (args)
(apply add-swindle-language args)) (apply add-swindle-language `(,@args #f)))
'(("Swindle" "swindle" "Full Swindle" '(("Swindle" "swindle" "Full Swindle" 0
"Full Swindle extensions" #t #f 0) "Full Swindle extensions")
("Swindle w/o CLOS" "turbo" "Swindle without CLOS" ("Swindle w/o CLOS" "turbo" "Swindle without CLOS" 1
"Swindle without the object system" #t #f 1) "Swindle without the object system")
("Swindle Syntax" "base" "Basic syntax only" ("Swindle Syntax" "base" "Basic syntax only" 2
"Basic Swindle syntax: keyword-arguments etc" #t #f 2) "Basic Swindle syntax: keyword-arguments etc")
("HTML Swindle" "html" "HTML Swindle" ("HTML Swindle" "html" "HTML Swindle" 3
"Swindle's HTML extension" #t #f 3))) "Swindle's HTML extension")))
(parameterize ([current-directory (collection-path "swindle")]) (parameterize ([current-directory (collection-path "swindle")])
(define counter 100)
(define (do-customize file) (define (do-customize file)
(when (regexp-match #rx"\\.ss$" file) (when (regexp-match #rx"\\.ss$" file)
(with-input-from-file file (with-input-from-file file
@ -161,8 +154,9 @@
(unless one-line (unless one-line
(set! one-line (set! one-line
(string-append "Customized Swindle: " name))) (string-append "Customized Swindle: " name)))
(unless url (set! url swindle-url)) (set! counter (add1 counter))
(add-swindle-language (add-swindle-language
name file dname one-line #f url 50)))))))) name file dname counter one-line url))))))))
(for-each do-customize (map path->string (directory-list))))) (for-each do-customize
(sort (map path->string (directory-list)) string<?))))
))) )))