guide and reference work; change opt-lambda to use lambda/kw and hack in keyword support for documentation purposes, along with define-opt
svn: r6572 original commit: 32e91015944dc36313bd5662390d93e33967047e
This commit is contained in:
Matthew Flatt
parent
d7c846e425
commit
6281c85249
|
|
@ -210,9 +210,9 @@
|
|||
[(_ (eval:alts a b)) (schemeinput* a)]
|
||||
[(_ e) (schemeinput e)]))
|
||||
|
||||
(define (defspace p)
|
||||
(make-flow (list p
|
||||
(make-paragraph null))))
|
||||
(define-code schemeblock+line (to-paragraph/prefix (hspace 2)
|
||||
(hspace 2)
|
||||
(list " ")))
|
||||
|
||||
(define-syntax (schemedefinput* stx)
|
||||
(syntax-case stx (eval-example-string define define-struct)
|
||||
|
|
@ -220,13 +220,13 @@
|
|||
#'(schemeinput* (eval-example-string s))]
|
||||
[(_ (define . rest))
|
||||
(syntax-case stx ()
|
||||
[(_ e) #'(defspace (schemeblock e))])]
|
||||
[(_ e) #'(schemeblock+line e)])]
|
||||
[(_ (define-struct . rest))
|
||||
(syntax-case stx ()
|
||||
[(_ e) #'(defspace (schemeblock e))])]
|
||||
[(_ e) #'(schemeblock+line e)])]
|
||||
[(_ (code:line (define . rest) . rest2))
|
||||
(syntax-case stx ()
|
||||
[(_ e) #'(defspace (schemeblock e))])]
|
||||
[(_ e) #'(schemeblock+line e)])]
|
||||
[(_ e) #'(schemeinput e)]))
|
||||
|
||||
(define-syntax titled-interaction
|
||||
|
|
|
|||
|
|
@ -75,7 +75,7 @@
|
|||
(pair? number))
|
||||
(printf "\\~a~a{"
|
||||
(case (length number)
|
||||
[(0 1) "section"]
|
||||
[(0 1) "newpage\n\n\\section"]
|
||||
[(2) "subsection"]
|
||||
[(3) "subsubsection"]
|
||||
[else "subsubsection*"])
|
||||
|
|
|
|||
|
|
@ -150,7 +150,8 @@
|
|||
;; ----------------------------------------
|
||||
|
||||
(provide defproc defproc* defstruct defthing defform defform* defform/subs defform*/subs defform/none
|
||||
specform specsubform specsubform/inline
|
||||
specform specform/subs
|
||||
specsubform specspecsubform specsubform/inline
|
||||
schemegrammar
|
||||
var svar void-const undefined-const)
|
||||
|
||||
|
|
@ -250,15 +251,30 @@
|
|||
(define-syntax specsubform
|
||||
(syntax-rules ()
|
||||
[(_ spec desc ...)
|
||||
(*specsubform 'spec #f (lambda () (schemeblock0 spec)) (lambda () (list desc ...)))]))
|
||||
(*specsubform 'spec #f (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))]))
|
||||
(define-syntax specspecsubform
|
||||
(syntax-rules ()
|
||||
[(_ spec desc ...)
|
||||
(make-blockquote "leftindent" (list (specsubform spec desc ...)))]))
|
||||
(define-syntax specform
|
||||
(syntax-rules ()
|
||||
[(_ spec desc ...)
|
||||
(*specsubform 'spec #t (lambda () (schemeblock0 spec)) (lambda () (list desc ...)))]))
|
||||
(*specsubform 'spec #t (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))]))
|
||||
(define-syntax specform/subs
|
||||
(syntax-rules ()
|
||||
[(_ spec ([non-term-id non-term-form ...] ...) desc ...)
|
||||
(*specsubform 'spec #t
|
||||
(lambda () (schemeblock0 spec))
|
||||
'((non-term-id non-term-form ...) ...)
|
||||
(list (list (lambda () (scheme non-term-id))
|
||||
(lambda () (schemeblock0 non-term-form))
|
||||
...)
|
||||
...)
|
||||
(lambda () (list desc ...)))]))
|
||||
(define-syntax specsubform/inline
|
||||
(syntax-rules ()
|
||||
[(_ spec desc ...)
|
||||
(*specsubform 'spec #f #f (lambda () (list desc ...)))]))
|
||||
(*specsubform 'spec #f #f null null (lambda () (list desc ...)))]))
|
||||
(define-syntax defthing
|
||||
(syntax-rules ()
|
||||
[(_ id result desc ...)
|
||||
|
|
@ -523,9 +539,10 @@
|
|||
sub-procs))))
|
||||
(content-thunk)))))
|
||||
|
||||
(define (*specsubform form has-kw? form-thunk content-thunk)
|
||||
(define (*specsubform form has-kw? form-thunk subs sub-procs content-thunk)
|
||||
(parameterize ([current-variable-list
|
||||
(append (let loop ([form (if has-kw? (cdr form) form)])
|
||||
(append (let loop ([form (cons (if has-kw? (cdr form) form)
|
||||
subs)])
|
||||
(cond
|
||||
[(symbol? form) (if (meta-symbol? form)
|
||||
null
|
||||
|
|
@ -539,12 +556,20 @@
|
|||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
(list (list
|
||||
(make-flow
|
||||
(list
|
||||
(if form-thunk
|
||||
(form-thunk)
|
||||
(make-paragraph (list (to-element form)))))))))
|
||||
(cons
|
||||
(list
|
||||
(make-flow
|
||||
(list
|
||||
(if form-thunk
|
||||
(form-thunk)
|
||||
(make-paragraph (list (to-element form)))))))
|
||||
(apply
|
||||
append
|
||||
(map (lambda (sub)
|
||||
(list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
|
||||
(list (make-flow (list (apply *schemerawgrammar
|
||||
(map (lambda (f) (f)) sub)))))))
|
||||
sub-procs))))
|
||||
(flow-paragraphs (decode-flow (content-thunk)))))))
|
||||
|
||||
(define (*schemerawgrammar nonterm clause1 . clauses)
|
||||
|
|
@ -643,5 +668,29 @@
|
|||
[else (list i)])))
|
||||
c)))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(provide cite)
|
||||
|
||||
(define/kw (cite #:key key title author location date)
|
||||
"[...]"
|
||||
#;
|
||||
(make-bibliography-element
|
||||
#f
|
||||
(list "[...]")
|
||||
key
|
||||
(list (string-append
|
||||
(content->string (list author))
|
||||
", "
|
||||
(content->string (list title))))
|
||||
(list (make-element #f (list author
|
||||
", "
|
||||
title
|
||||
", "
|
||||
date
|
||||
". "
|
||||
location
|
||||
".")))))
|
||||
|
||||
;; ----------------------------------------
|
||||
)
|
||||
|
|
|
|||
|
|
@ -369,7 +369,6 @@
|
|||
(string? (syntax-e c))
|
||||
(bytes? (syntax-e c))
|
||||
(char? (syntax-e c))
|
||||
(keyword? (syntax-e c))
|
||||
(boolean? (syntax-e c)))
|
||||
value-color]
|
||||
[(identifier? c)
|
||||
|
|
@ -389,7 +388,12 @@
|
|||
(set! dest-col 0)
|
||||
(hash-table-put! next-col-map init-col dest-col)
|
||||
((loop (lambda () (set! src-col init-col) (set! dest-col 0)) 0) c)
|
||||
(out suffix #f)
|
||||
(if (list? suffix)
|
||||
(map (lambda (sfx)
|
||||
(finish-line!)
|
||||
(out sfx #f))
|
||||
suffix)
|
||||
(out suffix #f))
|
||||
(unless (null? content)
|
||||
(finish-line!))
|
||||
(if multi-line?
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user