Changing from racket to racket/base in xml, html, and web-server
This commit is contained in:
parent
f675514a2b
commit
611e8d0d17
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require "sgml-reader.rkt")
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
"sgml-reader.rkt")
|
||||
(provide/contract
|
||||
[html-spec spec/c])
|
||||
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require xml)
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
xml)
|
||||
|
||||
(define-struct html-element (attributes))
|
||||
(define-struct (html-full html-element) (content))
|
||||
|
|
|
@ -1,9 +1,10 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
;; copyright by Paul Graunke June 2000 AD
|
||||
|
||||
(require "html-structs.rkt"
|
||||
"html-spec.rkt"
|
||||
"sgml-reader.rkt"
|
||||
racket/contract
|
||||
xml)
|
||||
|
||||
(provide (all-from-out "html-structs.rkt")
|
||||
|
|
|
@ -1,9 +1,10 @@
|
|||
;; copyright by Paul Graunke June 2000 AD
|
||||
;; warning - this was copied from the XML collection.
|
||||
;; It needs to be abstracted back in.
|
||||
#lang racket
|
||||
#lang racket/base
|
||||
(require xml
|
||||
(prefix-in racket: racket))
|
||||
racket/contract
|
||||
(prefix-in racket: racket/base))
|
||||
|
||||
;; Kid-lister : (Symbol -> (U (listof Symbol) #f))
|
||||
(define kid-lister/c
|
||||
|
|
|
@ -1,5 +1,8 @@
|
|||
#lang racket
|
||||
(require racket/pretty
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
(for-syntax racket/base)
|
||||
racket/pretty
|
||||
racket/runtime-path
|
||||
"configuration-table-structs.rkt"
|
||||
web-server/http/bindings)
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require racket/runtime-path)
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
racket/runtime-path)
|
||||
|
||||
(define-runtime-module-path racket-module-spec racket)
|
||||
(define mred-module-spec 'mred)
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require racket/runtime-path
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
(for-syntax racket/base)
|
||||
racket/runtime-path
|
||||
net/url
|
||||
web-server/private/xexpr
|
||||
web-server/http/xexpr
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/servlet)
|
||||
|
||||
(define (extract-number req)
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/servlet
|
||||
web-server/formlets)
|
||||
(provide (all-defined-out))
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/servlet
|
||||
web-server/formlets)
|
||||
(provide (all-defined-out))
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/servlet
|
||||
web-server/formlets)
|
||||
(provide (all-defined-out))
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/servlet)
|
||||
#lang racket/base
|
||||
(require racket/match
|
||||
web-server/servlet)
|
||||
(provide (all-defined-out))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
;; Written by Don Felgar, edited by Greg Pettyjohn
|
||||
;;
|
||||
;; Multiple-choice quiz Racket servlet sample.
|
||||
|
@ -13,7 +13,9 @@
|
|||
;; correct-answer = integer, index into choices
|
||||
;;
|
||||
;; Configuration
|
||||
(require racket/runtime-path)
|
||||
(require racket/runtime-path
|
||||
racket/file
|
||||
(for-syntax racket/base))
|
||||
(define-runtime-path *data-file*
|
||||
(list 'lib
|
||||
"web-server/default-web-root/htdocs/servlets/examples/english-measure-questions.rkt"))
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/templates
|
||||
web-server/http
|
||||
web-server/compat/0/coerce)
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/templates
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
web-server/templates
|
||||
web-server/http)
|
||||
(provide (all-defined-out))
|
||||
(define interface-version 'v1)
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/templates
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
web-server/templates
|
||||
web-server/http)
|
||||
(provide (all-defined-out))
|
||||
(define interface-version 'v1)
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/templates
|
||||
web-server/http
|
||||
xml)
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/servlet)
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/servlet)
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require racket/stxparam)
|
||||
#lang racket/base
|
||||
(require (for-syntax racket/base)
|
||||
racket/match
|
||||
racket/stxparam)
|
||||
|
||||
(define-syntax-parameter bidi-match-going-in? #t)
|
||||
|
||||
|
|
|
@ -1,4 +1,7 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/match
|
||||
(for-syntax racket/base))
|
||||
|
||||
(define (make-coerce-safe? coerce)
|
||||
(lambda (x)
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/dispatch/coercion
|
||||
web-server/dispatch/bidi-match)
|
||||
(provide (all-from-out web-server/dispatch/coercion
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require net/url
|
||||
#lang racket/base
|
||||
(require racket/match
|
||||
net/url
|
||||
web-server/http)
|
||||
|
||||
(define-match-expander url/path
|
||||
|
|
|
@ -1,4 +1,7 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
racket/contract)
|
||||
|
||||
; A dispatch pattern is either
|
||||
; - a string
|
||||
; - a bidi match expander
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/servlet-env
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
web-server/servlet-env
|
||||
web-server/servlet/servlet-structs
|
||||
web-server/http)
|
||||
|
||||
|
|
|
@ -1,10 +1,13 @@
|
|||
#lang racket
|
||||
(require racket/stxparam
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
racket/match
|
||||
racket/stxparam
|
||||
net/url
|
||||
web-server/dispatchers/dispatch
|
||||
web-server/dispatch/http-expanders
|
||||
web-server/dispatch/bidi-match
|
||||
(for-syntax web-server/dispatch/pattern))
|
||||
(for-syntax racket/base
|
||||
web-server/dispatch/pattern))
|
||||
|
||||
(define (default-else req)
|
||||
(next-dispatcher))
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/dispatch/coercion
|
||||
#lang racket/base
|
||||
(require racket/match
|
||||
web-server/dispatch/coercion
|
||||
web-server/dispatch/bidi-match)
|
||||
|
||||
(define-syntax define-bidi-match-expander/coercions
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require web-server/dispatchers/dispatch)
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
web-server/dispatchers/dispatch)
|
||||
(provide/contract
|
||||
[interface-version dispatcher-interface-version/c]
|
||||
[make (() () #:rest (listof dispatcher/c) . ->* . dispatcher/c)])
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require web-server/dispatchers/dispatch)
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
web-server/dispatchers/dispatch)
|
||||
(provide/contract
|
||||
[interface-version dispatcher-interface-version/c]
|
||||
[make ((number? dispatcher/c) (#:over-limit (symbols 'block 'kill-new 'kill-old)) . ->* . dispatcher/c)])
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/formlets/syntax
|
||||
web-server/formlets/dyn-syntax
|
||||
web-server/formlets/input
|
||||
|
|
|
@ -1,7 +1,12 @@
|
|||
#lang racket
|
||||
(require (for-syntax racket
|
||||
#lang racket/base
|
||||
(require (for-syntax racket/base
|
||||
racket/local
|
||||
racket/list
|
||||
syntax/parse
|
||||
syntax/strip-context)
|
||||
racket/function
|
||||
racket/list
|
||||
racket/match
|
||||
racket/stxparam
|
||||
"lib.rkt"
|
||||
"syntax.rkt"
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require web-server/http
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
web-server/http
|
||||
web-server/private/xexpr
|
||||
(only-in "lib.rkt"
|
||||
formlet/c
|
||||
|
|
|
@ -1,9 +1,11 @@
|
|||
#lang racket
|
||||
(require web-server/http
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
racket/contract
|
||||
racket/function
|
||||
web-server/http
|
||||
web-server/private/xexpr)
|
||||
|
||||
; Combinators
|
||||
(define (const x) (lambda _ x))
|
||||
(define (id x) x)
|
||||
|
||||
; Formlets
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/servlet
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
web-server/servlet
|
||||
web-server/private/xexpr
|
||||
"lib.rkt")
|
||||
|
||||
|
|
|
@ -1,7 +1,9 @@
|
|||
#lang racket
|
||||
(require (for-syntax racket
|
||||
#lang racket/base
|
||||
(require (for-syntax racket/base
|
||||
syntax/parse)
|
||||
racket/stxparam
|
||||
racket/match
|
||||
racket/list
|
||||
"lib.rkt"
|
||||
(for-syntax "lib.rkt"))
|
||||
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require net/base64
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/match
|
||||
net/base64
|
||||
web-server/http/request-structs)
|
||||
|
||||
(define (request->basic-credentials req)
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require web-server/http/request-structs
|
||||
#lang racket/base
|
||||
(require racket/port
|
||||
racket/match
|
||||
web-server/http/request-structs
|
||||
net/cookie
|
||||
web-server/private/util
|
||||
racket/contract)
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require net/cookie
|
||||
web-server/http/request-structs
|
||||
web-server/http/response-structs
|
||||
|
|
|
@ -1,5 +1,8 @@
|
|||
#lang racket
|
||||
(require net/base64
|
||||
#lang racket/base
|
||||
(require racket/port
|
||||
racket/match
|
||||
racket/contract
|
||||
net/base64
|
||||
file/md5
|
||||
web-server/http/request-structs)
|
||||
|
||||
|
|
|
@ -1,5 +1,8 @@
|
|||
#lang racket
|
||||
(require racket/serialize
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
racket/match
|
||||
racket/serialize
|
||||
web-server/private/servlet
|
||||
web-server/managers/manager
|
||||
web-server/private/define-closure
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require syntax/free-vars
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
syntax/free-vars
|
||||
racket/syntax
|
||||
(for-template
|
||||
racket/base
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require file/md5)
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
file/md5)
|
||||
(provide/contract
|
||||
[make-labeling (bytes? . -> . (-> symbol?))])
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/lang/abort-resume
|
||||
(for-syntax racket))
|
||||
(for-syntax racket/base))
|
||||
|
||||
(define-syntax (define-native stx)
|
||||
(syntax-case stx ()
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
#lang racket
|
||||
(require racket/serialize
|
||||
(for-syntax racket
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
racket/serialize
|
||||
(for-syntax racket/base
|
||||
web-server/lang/closure
|
||||
web-server/lang/labels))
|
||||
|
||||
|
|
|
@ -1,5 +1,8 @@
|
|||
#lang racket
|
||||
(require racket/serialize)
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/match
|
||||
racket/local
|
||||
racket/serialize)
|
||||
|
||||
(define-serializable-struct soft-state-record (thnk))
|
||||
(define-struct some (value))
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require net/url
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
net/url
|
||||
racket/serialize
|
||||
web-server/private/servlet
|
||||
web-server/stuffers/stuffer
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require racket/serialize
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
racket/serialize
|
||||
web-server/lang/serial-lambda)
|
||||
;; Implementation: Have a distinguished frame variable that is read and captured by send/suspend,
|
||||
;; installed on invocations of continuations by the server (and NOT from other continuation invocations)
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require net/url
|
||||
#lang racket/base
|
||||
(require racket/match
|
||||
net/url
|
||||
racket/contract
|
||||
racket/serialize
|
||||
web-server/servlet/servlet-structs
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require racket/async-channel
|
||||
#lang racket/base
|
||||
(require racket/unit
|
||||
racket/contract
|
||||
racket/async-channel
|
||||
web-server/private/util
|
||||
unstable/contract
|
||||
web-server/private/connection-manager)
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require file/gzip
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
file/gzip
|
||||
file/gunzip)
|
||||
|
||||
(provide/contract
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require racket/cmdline
|
||||
racket/unit
|
||||
net/tcp-sig
|
||||
|
|
|
@ -1,4 +1,7 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
racket/match)
|
||||
(provide/contract
|
||||
[compress-serial (list? . -> . list?)]
|
||||
[decompress-serial (list? . -> . list?)])
|
||||
|
|
|
@ -1,5 +1,8 @@
|
|||
#lang racket
|
||||
(require racket/pretty
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/match
|
||||
racket/list
|
||||
racket/pretty
|
||||
xml)
|
||||
|
||||
(define-struct (exn:pretty exn) (xexpr))
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require "../dummy-sqlite.rkt")
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
racket/local
|
||||
"../dummy-sqlite.rkt")
|
||||
|
||||
;; A blog is a (make-blog db)
|
||||
;; where db is an sqlite database handle
|
||||
|
|
|
@ -1,4 +1,6 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require racket/local
|
||||
racket/list)
|
||||
|
||||
;; A blog is a (make-blog home posts)
|
||||
;; where home is a string, posts is a (listof post)
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require db)
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
racket/local
|
||||
db)
|
||||
|
||||
;; A blog is a (make-blog db)
|
||||
;; where db is an sqlite connection
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
|
||||
;; A blog is a (make-blog posts)
|
||||
;; where posts is a (listof post)
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require scribble/basic
|
||||
(for-syntax racket/port)
|
||||
(for-syntax racket/base
|
||||
racket/port)
|
||||
racket/include
|
||||
(except-in scribble/manual link))
|
||||
(provide external-file)
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require scribble/manual
|
||||
scribble/eval
|
||||
(for-syntax racket/base)
|
||||
(for-label racket/base
|
||||
racket/contract
|
||||
racket/unit))
|
||||
|
|
|
@ -1,7 +1,9 @@
|
|||
; Derived from plai/web/server, which was based on an older version of this
|
||||
; Also derived from planet/untyped/instaservlet
|
||||
#lang racket
|
||||
#lang racket/base
|
||||
(require (prefix-in net: net/sendurl)
|
||||
racket/match
|
||||
racket/local
|
||||
racket/contract
|
||||
racket/async-channel
|
||||
racket/list
|
||||
|
|
|
@ -1,10 +1,11 @@
|
|||
; Derived from plai/web/server, which was based on an older version of this
|
||||
; Also derived from planet/untyped/instaservlet
|
||||
#lang racket
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
racket/serialize
|
||||
racket/runtime-path)
|
||||
racket/runtime-path
|
||||
(for-syntax racket/base))
|
||||
(require net/url
|
||||
web-server/managers/lru
|
||||
web-server/managers/manager
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require racket/serialize
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/match
|
||||
racket/serialize
|
||||
web-server/managers/manager
|
||||
web-server/managers/timeouts
|
||||
web-server/managers/none
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
;; Implementation: Have a distinguished frame variable that is read and captured by send/suspend,
|
||||
;; installed on invocations of continuations by the server (and NOT from other continuation invocations)
|
||||
(require racket/list
|
||||
racket/contract)
|
||||
|
||||
;; Data types
|
||||
(define-struct primitive-wc (id))
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require net/url)
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
net/url)
|
||||
(require web-server/managers/manager
|
||||
web-server/private/util
|
||||
web-server/private/servlet
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require web-server/stuffers/stuffer
|
||||
web-server/stuffers/base64
|
||||
web-server/stuffers/gzip
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/stuffers/stuffer
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
web-server/stuffers/stuffer
|
||||
net/base64)
|
||||
|
||||
(define base64-stuffer
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/private/gzip
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
web-server/private/gzip
|
||||
web-server/stuffers/stuffer)
|
||||
|
||||
(define gzip-stuffer
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/stuffers/stuffer
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
web-server/stuffers/stuffer
|
||||
web-server/stuffers/store
|
||||
file/md5)
|
||||
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require web-server/stuffers/stuffer
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
web-server/stuffers/stuffer
|
||||
racket/runtime-path
|
||||
openssl/libcrypto
|
||||
(rename-in ffi/unsafe
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require racket/serialize
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/serialize
|
||||
web-server/stuffers/stuffer
|
||||
web-server/private/util
|
||||
web-server/private/mod-map)
|
||||
|
|
|
@ -1,4 +1,6 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require racket/contract)
|
||||
|
||||
(define-struct store (write read))
|
||||
|
||||
(define (dir-store home)
|
||||
|
|
|
@ -1,4 +1,7 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/match)
|
||||
|
||||
(define-struct stuffer (in out))
|
||||
(define (stuffer/c dom rng)
|
||||
(define in (dom . -> . rng))
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require web-server/private/util
|
||||
#lang racket/base
|
||||
(require racket/unit
|
||||
racket/contract
|
||||
web-server/private/util
|
||||
web-server/configuration/namespace
|
||||
web-server/configuration/configuration-table-structs)
|
||||
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require xml)
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
racket/contract
|
||||
xml)
|
||||
|
||||
; a dict is (list 'dict assoc-pair ...)
|
||||
; an assoc-pair is (list 'assoc-pair key value)
|
||||
|
|
|
@ -1,5 +1,8 @@
|
|||
#lang racket
|
||||
(require "structures.rkt")
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
racket/match
|
||||
"structures.rkt")
|
||||
|
||||
(provide/contract
|
||||
[read-xml (() (input-port?) . ->* . document?)]
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require "structures.rkt")
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
"structures.rkt")
|
||||
(provide/contract
|
||||
[eliminate-whitespace (() ((listof symbol?) (boolean? . -> . boolean?)) . ->* . (element? . -> . element?))])
|
||||
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
#lang racket
|
||||
(require "structures.rkt"
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/list
|
||||
"structures.rkt"
|
||||
"reader.rkt"
|
||||
"xexpr.rkt")
|
||||
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require "structures.rkt")
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
"structures.rkt")
|
||||
|
||||
(provide/contract
|
||||
[write-xml ((document?) (output-port?) . ->* . void?)]
|
||||
|
|
|
@ -1,35 +1,35 @@
|
|||
(module scheme-snipclass mzscheme
|
||||
(require stepper/private/xml-snip-helpers
|
||||
mzlib/class
|
||||
mred)
|
||||
|
||||
(provide snip-class scheme-snip%)
|
||||
#lang racket/base
|
||||
(require stepper/private/xml-snip-helpers
|
||||
mzlib/class
|
||||
mred)
|
||||
|
||||
(define scheme-snip%
|
||||
(class* editor-snip% (scheme-snip<%> readable-snip<%>)
|
||||
(init-field splice?)
|
||||
(define/public (get-splice?) splice?)
|
||||
(provide snip-class scheme-snip%)
|
||||
|
||||
(define/public (read-special file line col pos)
|
||||
(scheme-read-special this
|
||||
file
|
||||
line
|
||||
col
|
||||
pos))
|
||||
|
||||
(super-instantiate ())))
|
||||
|
||||
(define scheme-snipclass%
|
||||
(class snip-class%
|
||||
(define/override (read stream-in)
|
||||
(let* ([splice? (zero? (send stream-in get-exact))]
|
||||
[snip (instantiate scheme-snip% ()
|
||||
(splice? splice?))])
|
||||
(send (send snip get-editor) read-from-file stream-in #f)
|
||||
snip))
|
||||
(super-instantiate ())))
|
||||
|
||||
(define snip-class (make-object scheme-snipclass%))
|
||||
(send snip-class set-version 1)
|
||||
(send snip-class set-classname (format "~s" '(lib "scheme-snipclass.rkt" "xml")))
|
||||
(send (get-the-snip-class-list) add snip-class))
|
||||
(define scheme-snip%
|
||||
(class* editor-snip% (scheme-snip<%> readable-snip<%>)
|
||||
(init-field splice?)
|
||||
(define/public (get-splice?) splice?)
|
||||
|
||||
(define/public (read-special file line col pos)
|
||||
(scheme-read-special this
|
||||
file
|
||||
line
|
||||
col
|
||||
pos))
|
||||
|
||||
(super-instantiate ())))
|
||||
|
||||
(define scheme-snipclass%
|
||||
(class snip-class%
|
||||
(define/override (read stream-in)
|
||||
(let* ([splice? (zero? (send stream-in get-exact))]
|
||||
[snip (instantiate scheme-snip% ()
|
||||
(splice? splice?))])
|
||||
(send (send snip get-editor) read-from-file stream-in #f)
|
||||
snip))
|
||||
(super-instantiate ())))
|
||||
|
||||
(define snip-class (make-object scheme-snipclass%))
|
||||
(send snip-class set-version 1)
|
||||
(send snip-class set-classname (format "~s" '(lib "scheme-snipclass.rkt" "xml")))
|
||||
(send (get-the-snip-class-list) add snip-class)
|
||||
|
|
|
@ -1,37 +1,37 @@
|
|||
(module text-box-tool mzscheme
|
||||
(require drscheme/tool
|
||||
mred
|
||||
framework
|
||||
"text-snipclass.rkt"
|
||||
mzlib/unit
|
||||
mzlib/class
|
||||
string-constants
|
||||
mrlib/include-bitmap)
|
||||
|
||||
(provide tool@)
|
||||
#lang racket/base
|
||||
(require drscheme/tool
|
||||
mred
|
||||
framework
|
||||
"text-snipclass.rkt"
|
||||
mzlib/unit
|
||||
mzlib/class
|
||||
string-constants
|
||||
mrlib/include-bitmap)
|
||||
|
||||
(define tool@
|
||||
(unit
|
||||
(import drscheme:tool^)
|
||||
(export drscheme:tool-exports^)
|
||||
(define (phase1) (void))
|
||||
(define (phase2) (void))
|
||||
|
||||
(define (text-box-mixin %)
|
||||
(class %
|
||||
(inherit get-insert-menu get-edit-target-object register-capability-menu-item)
|
||||
(super-new)
|
||||
(new menu-item%
|
||||
(label (string-constant insert-text-box-item))
|
||||
(parent (get-insert-menu))
|
||||
(callback
|
||||
(lambda (menu event)
|
||||
(let ([c-box (new text-box%)]
|
||||
[text (get-edit-target-object)])
|
||||
(send text insert c-box)
|
||||
(send text set-caret-owner c-box 'global)))))
|
||||
(register-capability-menu-item 'drscheme:special:insert-text-box (get-insert-menu))))
|
||||
|
||||
(drscheme:get/extend:extend-unit-frame text-box-mixin)
|
||||
|
||||
(drscheme:language:register-capability 'drscheme:special:insert-text-box boolean? #t))))
|
||||
(provide tool@)
|
||||
|
||||
(define tool@
|
||||
(unit
|
||||
(import drscheme:tool^)
|
||||
(export drscheme:tool-exports^)
|
||||
(define (phase1) (void))
|
||||
(define (phase2) (void))
|
||||
|
||||
(define (text-box-mixin %)
|
||||
(class %
|
||||
(inherit get-insert-menu get-edit-target-object register-capability-menu-item)
|
||||
(super-new)
|
||||
(new menu-item%
|
||||
(label (string-constant insert-text-box-item))
|
||||
(parent (get-insert-menu))
|
||||
(callback
|
||||
(lambda (menu event)
|
||||
(let ([c-box (new text-box%)]
|
||||
[text (get-edit-target-object)])
|
||||
(send text insert c-box)
|
||||
(send text set-caret-owner c-box 'global)))))
|
||||
(register-capability-menu-item 'drscheme:special:insert-text-box (get-insert-menu))))
|
||||
|
||||
(drscheme:get/extend:extend-unit-frame text-box-mixin)
|
||||
|
||||
(drscheme:language:register-capability 'drscheme:special:insert-text-box boolean? #t)))
|
||||
|
|
|
@ -1,148 +1,148 @@
|
|||
(module text-snipclass mzscheme
|
||||
(require framework
|
||||
mzlib/class
|
||||
mred)
|
||||
#lang racket/base
|
||||
(require framework
|
||||
mzlib/class
|
||||
mred)
|
||||
|
||||
(provide text-box%
|
||||
(rename snipclass snip-class))
|
||||
(provide text-box%
|
||||
(rename-out [snipclass snip-class]))
|
||||
|
||||
;; chunk-string: (listof any) -> (listof any)
|
||||
(define (chunk-string s acc)
|
||||
(cond
|
||||
((and (null? s) (null? acc)) null)
|
||||
((null? s) (list (list->string (reverse acc))))
|
||||
((char? (car s)) (chunk-string (cdr s) (cons (car s) acc)))
|
||||
((null? acc) (cons (car s) (chunk-string (cdr s) null)))
|
||||
(else (cons (list->string (reverse acc)) (cons (car s) (chunk-string (cdr s) null))))))
|
||||
|
||||
(define get-icon
|
||||
(let ([icon #f])
|
||||
(λ ()
|
||||
(unless icon
|
||||
(let ()
|
||||
(define str "“”")
|
||||
(define bdc (make-object bitmap-dc% (make-object bitmap% 1 1)))
|
||||
(define font (send the-font-list find-or-create-font 24 'default 'normal 'normal))
|
||||
(define-values (w h _1 _2) (send bdc get-text-extent str font))
|
||||
(define bmp (make-object bitmap% (floor (inexact->exact w)) (floor (inexact->exact h))))
|
||||
(send bdc set-bitmap bmp)
|
||||
(send bdc set-smoothing 'aligned)
|
||||
(send bdc set-font font)
|
||||
(send bdc clear)
|
||||
(send bdc draw-text str 0 0)
|
||||
(send bdc set-bitmap #f)
|
||||
(set! icon bmp)))
|
||||
icon)))
|
||||
|
||||
|
||||
;; marshall: writable -> string
|
||||
(define (marshall s)
|
||||
(let ((os (open-output-string)))
|
||||
(with-handlers ((exn:fail? (lambda (x) "")))
|
||||
(write s os)
|
||||
(get-output-string os))))
|
||||
;; chunk-string: (listof any) -> (listof any)
|
||||
(define (chunk-string s acc)
|
||||
(cond
|
||||
((and (null? s) (null? acc)) null)
|
||||
((null? s) (list (list->string (reverse acc))))
|
||||
((char? (car s)) (chunk-string (cdr s) (cons (car s) acc)))
|
||||
((null? acc) (cons (car s) (chunk-string (cdr s) null)))
|
||||
(else (cons (list->string (reverse acc)) (cons (car s) (chunk-string (cdr s) null))))))
|
||||
|
||||
(define snipclass-text-box%
|
||||
(class decorated-editor-snipclass%
|
||||
(define/override (make-snip stream-in) (new text-box%))
|
||||
(super-instantiate ())))
|
||||
|
||||
(define old-snipclass (new snipclass-text-box%))
|
||||
(send old-snipclass set-version 1)
|
||||
(send old-snipclass set-classname "text-box%")
|
||||
(send (get-the-snip-class-list) add old-snipclass)
|
||||
(define get-icon
|
||||
(let ([icon #f])
|
||||
(λ ()
|
||||
(unless icon
|
||||
(let ()
|
||||
(define str "“”")
|
||||
(define bdc (make-object bitmap-dc% (make-object bitmap% 1 1)))
|
||||
(define font (send the-font-list find-or-create-font 24 'default 'normal 'normal))
|
||||
(define-values (w h _1 _2) (send bdc get-text-extent str font))
|
||||
(define bmp (make-object bitmap% (floor (inexact->exact w)) (floor (inexact->exact h))))
|
||||
(send bdc set-bitmap bmp)
|
||||
(send bdc set-smoothing 'aligned)
|
||||
(send bdc set-font font)
|
||||
(send bdc clear)
|
||||
(send bdc draw-text str 0 0)
|
||||
(send bdc set-bitmap #f)
|
||||
(set! icon bmp)))
|
||||
icon)))
|
||||
|
||||
(define snipclass (new snipclass-text-box%))
|
||||
(send snipclass set-version 1)
|
||||
(send snipclass set-classname (format "~s" '(lib "text-snipclass.ss" "xml")))
|
||||
(send (get-the-snip-class-list) add snipclass)
|
||||
|
||||
(define text-box%
|
||||
(class* decorated-editor-snip% (readable-snip<%>)
|
||||
(define/override (make-editor) (let ([e (new text:keymap%)])
|
||||
(send e set-max-undo-history 'forever)
|
||||
e))
|
||||
(define/override (make-snip) (make-object text-box%))
|
||||
(inherit get-editor get-admin)
|
||||
|
||||
|
||||
(define/override (get-corner-bitmap)
|
||||
(get-icon))
|
||||
;; marshall: writable -> string
|
||||
(define (marshall s)
|
||||
(let ((os (open-output-string)))
|
||||
(with-handlers ((exn:fail? (lambda (x) "")))
|
||||
(write s os)
|
||||
(get-output-string os))))
|
||||
|
||||
(define/override (get-menu)
|
||||
(let ([menu (new popup-menu%)])
|
||||
(new menu-item%
|
||||
(label "Convert to string")
|
||||
(parent menu)
|
||||
(callback
|
||||
(lambda (x y)
|
||||
(let ([to-ed (find-containing-editor)])
|
||||
(when to-ed
|
||||
(let ([this-pos (find-this-position)])
|
||||
(when this-pos
|
||||
(let ([from-ed (get-editor)])
|
||||
(send to-ed begin-edit-sequence)
|
||||
(send from-ed begin-edit-sequence)
|
||||
(send to-ed delete this-pos (+ this-pos 1))
|
||||
(let* ((p (open-input-text-editor from-ed 0 'end
|
||||
(lambda (s)
|
||||
(values (box s) 1))))
|
||||
(contents
|
||||
(let loop ((next (read-char-or-special p)))
|
||||
(cond
|
||||
((eof-object? next) null)
|
||||
(else
|
||||
(cons next (loop (read-char-or-special p)))))))
|
||||
(repaired-contents
|
||||
(map (lambda (x)
|
||||
(if (string? x)
|
||||
(marshall x)
|
||||
(send (unbox x) copy)))
|
||||
(chunk-string contents null))))
|
||||
(for-each
|
||||
(lambda (x)
|
||||
(send to-ed insert x this-pos))
|
||||
(reverse repaired-contents)))
|
||||
(send to-ed end-edit-sequence)
|
||||
(send from-ed end-edit-sequence)))))))))
|
||||
menu))
|
||||
|
||||
;; find-containing-editor : -> (union #f editor)
|
||||
(define/private (find-containing-editor)
|
||||
(let ([admin (get-admin)])
|
||||
(and admin
|
||||
(send admin get-editor))))
|
||||
|
||||
;; find-this-position : -> (union #f number)
|
||||
(define/private (find-this-position)
|
||||
(let ([ed (find-containing-editor)])
|
||||
(and ed
|
||||
(send ed get-snip-position this))))
|
||||
(define snipclass-text-box%
|
||||
(class decorated-editor-snipclass%
|
||||
(define/override (make-snip stream-in) (new text-box%))
|
||||
(super-instantiate ())))
|
||||
|
||||
;; input-port -> (union (listof char) char eof-object? syntax-object)
|
||||
(define/private (get-next port)
|
||||
(let ([v (read-char-or-special port)])
|
||||
(if (special-comment? v)
|
||||
(get-next port)
|
||||
v)))
|
||||
|
||||
(define/public (read-special source line column position)
|
||||
(let* ((ed (get-editor))
|
||||
(port (open-input-text-editor ed))
|
||||
(str (let loop ((next (get-next port)))
|
||||
(cond
|
||||
((eof-object? next) null)
|
||||
((char? next)
|
||||
(cons next (loop (get-next port))))
|
||||
(else (cons #`(marshall #,next) (loop (get-next port))))))))
|
||||
#`(let ((marshall
|
||||
(lambda (s)
|
||||
(let ((os (open-output-string)))
|
||||
(with-handlers ((exn:fail? (lambda (x) "")))
|
||||
(display s os)
|
||||
(get-output-string os))))))
|
||||
(string-append #,@(chunk-string str null)))))
|
||||
|
||||
(super-instantiate ())
|
||||
(inherit set-snipclass)
|
||||
(set-snipclass snipclass))))
|
||||
(define old-snipclass (new snipclass-text-box%))
|
||||
(send old-snipclass set-version 1)
|
||||
(send old-snipclass set-classname "text-box%")
|
||||
(send (get-the-snip-class-list) add old-snipclass)
|
||||
|
||||
(define snipclass (new snipclass-text-box%))
|
||||
(send snipclass set-version 1)
|
||||
(send snipclass set-classname (format "~s" '(lib "text-snipclass.ss" "xml")))
|
||||
(send (get-the-snip-class-list) add snipclass)
|
||||
|
||||
(define text-box%
|
||||
(class* decorated-editor-snip% (readable-snip<%>)
|
||||
(define/override (make-editor) (let ([e (new text:keymap%)])
|
||||
(send e set-max-undo-history 'forever)
|
||||
e))
|
||||
(define/override (make-snip) (make-object text-box%))
|
||||
(inherit get-editor get-admin)
|
||||
|
||||
|
||||
(define/override (get-corner-bitmap)
|
||||
(get-icon))
|
||||
|
||||
(define/override (get-menu)
|
||||
(let ([menu (new popup-menu%)])
|
||||
(new menu-item%
|
||||
(label "Convert to string")
|
||||
(parent menu)
|
||||
(callback
|
||||
(lambda (x y)
|
||||
(let ([to-ed (find-containing-editor)])
|
||||
(when to-ed
|
||||
(let ([this-pos (find-this-position)])
|
||||
(when this-pos
|
||||
(let ([from-ed (get-editor)])
|
||||
(send to-ed begin-edit-sequence)
|
||||
(send from-ed begin-edit-sequence)
|
||||
(send to-ed delete this-pos (+ this-pos 1))
|
||||
(let* ((p (open-input-text-editor from-ed 0 'end
|
||||
(lambda (s)
|
||||
(values (box s) 1))))
|
||||
(contents
|
||||
(let loop ((next (read-char-or-special p)))
|
||||
(cond
|
||||
((eof-object? next) null)
|
||||
(else
|
||||
(cons next (loop (read-char-or-special p)))))))
|
||||
(repaired-contents
|
||||
(map (lambda (x)
|
||||
(if (string? x)
|
||||
(marshall x)
|
||||
(send (unbox x) copy)))
|
||||
(chunk-string contents null))))
|
||||
(for-each
|
||||
(lambda (x)
|
||||
(send to-ed insert x this-pos))
|
||||
(reverse repaired-contents)))
|
||||
(send to-ed end-edit-sequence)
|
||||
(send from-ed end-edit-sequence)))))))))
|
||||
menu))
|
||||
|
||||
;; find-containing-editor : -> (union #f editor)
|
||||
(define/private (find-containing-editor)
|
||||
(let ([admin (get-admin)])
|
||||
(and admin
|
||||
(send admin get-editor))))
|
||||
|
||||
;; find-this-position : -> (union #f number)
|
||||
(define/private (find-this-position)
|
||||
(let ([ed (find-containing-editor)])
|
||||
(and ed
|
||||
(send ed get-snip-position this))))
|
||||
|
||||
;; input-port -> (union (listof char) char eof-object? syntax-object)
|
||||
(define/private (get-next port)
|
||||
(let ([v (read-char-or-special port)])
|
||||
(if (special-comment? v)
|
||||
(get-next port)
|
||||
v)))
|
||||
|
||||
(define/public (read-special source line column position)
|
||||
(let* ((ed (get-editor))
|
||||
(port (open-input-text-editor ed))
|
||||
(str (let loop ((next (get-next port)))
|
||||
(cond
|
||||
((eof-object? next) null)
|
||||
((char? next)
|
||||
(cons next (loop (get-next port))))
|
||||
(else (cons #`(marshall #,next) (loop (get-next port))))))))
|
||||
#`(let ((marshall
|
||||
(lambda (s)
|
||||
(let ((os (open-output-string)))
|
||||
(with-handlers ((exn:fail? (lambda (x) "")))
|
||||
(display s os)
|
||||
(get-output-string os))))))
|
||||
(string-append #,@(chunk-string str null)))))
|
||||
|
||||
(super-instantiate ())
|
||||
(inherit set-snipclass)
|
||||
(set-snipclass snipclass)))
|
||||
|
|
|
@ -1,35 +1,35 @@
|
|||
(module xml-snipclass mzscheme
|
||||
(require stepper/private/xml-snip-helpers
|
||||
mzlib/class
|
||||
mred)
|
||||
|
||||
(provide snip-class xml-snip%)
|
||||
#lang racket/base
|
||||
(require stepper/private/xml-snip-helpers
|
||||
mzlib/class
|
||||
mred)
|
||||
|
||||
(define xml-snip%
|
||||
(class* editor-snip% (xml-snip<%> readable-snip<%>)
|
||||
(init-field eliminate-whitespace-in-empty-tags?)
|
||||
|
||||
(define/public (read-special file line col pos)
|
||||
(xml-read-special eliminate-whitespace-in-empty-tags?
|
||||
this
|
||||
file
|
||||
line
|
||||
col
|
||||
pos))
|
||||
|
||||
(super-new)))
|
||||
|
||||
(define xml-snipclass%
|
||||
(class snip-class%
|
||||
(define/override (read stream-in)
|
||||
(let* ([eliminate-whitespace-in-empty-tags? (zero? (send stream-in get-exact))]
|
||||
[snip (instantiate xml-snip% ()
|
||||
(eliminate-whitespace-in-empty-tags? eliminate-whitespace-in-empty-tags?))])
|
||||
(send (send snip get-editor) read-from-file stream-in #f)
|
||||
snip))
|
||||
(super-new)))
|
||||
|
||||
(define snip-class (make-object xml-snipclass%))
|
||||
(send snip-class set-version 1)
|
||||
(send snip-class set-classname (format "~s" '(lib "xml-snipclass.rkt" "xml")))
|
||||
(send (get-the-snip-class-list) add snip-class))
|
||||
(provide snip-class xml-snip%)
|
||||
|
||||
(define xml-snip%
|
||||
(class* editor-snip% (xml-snip<%> readable-snip<%>)
|
||||
(init-field eliminate-whitespace-in-empty-tags?)
|
||||
|
||||
(define/public (read-special file line col pos)
|
||||
(xml-read-special eliminate-whitespace-in-empty-tags?
|
||||
this
|
||||
file
|
||||
line
|
||||
col
|
||||
pos))
|
||||
|
||||
(super-new)))
|
||||
|
||||
(define xml-snipclass%
|
||||
(class snip-class%
|
||||
(define/override (read stream-in)
|
||||
(let* ([eliminate-whitespace-in-empty-tags? (zero? (send stream-in get-exact))]
|
||||
[snip (instantiate xml-snip% ()
|
||||
(eliminate-whitespace-in-empty-tags? eliminate-whitespace-in-empty-tags?))])
|
||||
(send (send snip get-editor) read-from-file stream-in #f)
|
||||
snip))
|
||||
(super-new)))
|
||||
|
||||
(define snip-class (make-object xml-snipclass%))
|
||||
(send snip-class set-version 1)
|
||||
(send snip-class set-classname (format "~s" '(lib "xml-snipclass.rkt" "xml")))
|
||||
(send (get-the-snip-class-list) add snip-class)
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang racket/base
|
||||
(require "private/structures.rkt"
|
||||
"private/reader.rkt"
|
||||
"private/space.rkt"
|
||||
|
|
Loading…
Reference in New Issue
Block a user