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

Remove unmaintained code

Browse Source 
svn: r6410
This commit is contained in:
Jay McCarthy 2007-05-30 16:10:14 +00:00
parent a3a8ba3636
commit e722401793
1 changed files with 0 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
collects/web-server/private/servlet-language.ss
View File

@ -1,104 +0,0 @@
(module servlet-language mzscheme
(require (lib "class.ss")
(lib "tool.ss" "drscheme")
(lib "contract.ss")
;(lib "mred.ss" "mred")
(lib "unit.ss"))
(provide/contract
[tool@ unit?])
(define tool@
(unit
(import drscheme:tool^)
(export drscheme:tool-exports^)
(define (phase1) (void))
(define (phase2)
(add-servlet-language))
;; add-servlet-language : -> void
;; adds the servlet language to drscheme
(define (add-servlet-language)
(define servlet-language%
(srvlt-lang-mixin
((drscheme:language:get-default-mixin)
(drscheme:language:module-based-language->language-mixin
(drscheme:language:simple-module-based-language->module-based-language-mixin
drscheme:language:simple-module-based-language%)))))
(drscheme:language-configuration:add-language
(instantiate servlet-language% ())))
(define servlet-language<%>
(interface ()
))
;; srvlt-lang-mixin : (implements drscheme:language:language<%>)
;; -> (implements drscheme:language:language<%>)
(define (srvlt-lang-mixin %)
(class* % (servlet-language<%>)
(field [program-results #f])
(define/override (on-execute settings run-in-user-thread)
(set! program-results #f)
(super on-execute settings run-in-user-thread)
(run-in-user-thread
(lambda ()
(error-display-handler
(drscheme:debug:make-debug-error-display-handler (error-display-handler)))
(current-eval
(drscheme:debug:make-debug-eval-handler (current-eval)))
(with-handlers ([void (lambda (x) (printf "~a~n" (exn-message x)))])
(eval '(define start-servlet (dynamic-require '(lib "servlet-startup.ss" "web-server") 'start-servlet)))
(eval '(define raw-servlet->unit/sig (dynamic-require '(lib "servlet-startup.ss" "web-server") 'raw-servlet->unit/sig)))
(eval '(define create-module-servlet (dynamic-require '(lib "servlet-startup.ss" "web-server") 'create-module-servlet)))))))
(define/override (front-end/complete-program input settings)
(let ([super-thunk (super front-end/complete-program input settings)])
(unless program-results
(let loop ([continue-with-results
(lambda (rslts)
(set! program-results rslts))]
[res-cadr #f])
(let ([res-car (super-thunk)])
(cond
;; end of empty definitions window
[(and (eof-object? res-car)
(eof-object? res-cadr))
(continue-with-results '())]
;; end of non-empty definitions window
[(and (eof-object? res-car) res-cadr)
;(continue-with-results (list #`(ignore-it #,res-cadr)))
(continue-with-results (list #`(start-servlet
(raw-servlet->unit/sig #,res-cadr))))
]
;; middle
[res-cadr
(loop
(lambda (rslts)
(continue-with-results (cons res-cadr rslts)))
res-car)]
;; start of definitions window
[else
(loop continue-with-results res-car)])))))
(lambda ()
(if (null? program-results)
eof
(begin0
(car program-results)
(set! program-results (cdr program-results)))))
)
(super-instantiate ()
(module '(lib "plt-mred.ss" "lang"))
;; GregP: when you settle on a name, use string-constant here
(language-position (list "Web Server" "Advanced Servlet"))
;; GregP: figure out what these language-numbers are
;(language-numbers (list -1000 1000))
))
))))