diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
index bbdacf7f..7bc8fc6c 100644
--- a/collects/scribble/html-render.ss
+++ b/collects/scribble/html-render.ss
@@ -203,6 +203,7 @@
`(td (,@(case a
[(#f) null]
[(right) '((align "right"))]
+ [(center) '((align "center"))]
[(left) '((align "left"))])
,@(case va
[(#f) null]
diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss
index 1e110a41..3355df2c 100644
--- a/collects/scribble/latex-render.ss
+++ b/collects/scribble/latex-render.ss
@@ -241,6 +241,9 @@
[(#\<) (if (rendering-tt)
(display "{\\texttt <}")
(display "$<$"))]
+ [(#\|) (if (rendering-tt)
+ (display "{\\texttt |}")
+ (display "$|$"))]
[(#\? #\! #\. #\:) (if (rendering-tt)
(printf "{\\hbox{\\texttt{~a}}}" c)
(display c))]
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index 49e7ab19..a7c85fdf 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -146,8 +146,9 @@
;; ----------------------------------------
- (provide defproc defproc* defstruct defthing defform defform* defform/none
+ (provide defproc defproc* defstruct defthing defform defform* defform/subs defform*/subs defform/none
specform specsubform specsubform/inline
+ schemegrammar
var svar void-const undefined-const)
(define void-const
@@ -205,9 +206,9 @@
(syntax-rules ()
[(_ name fields desc ...)
(*defstruct 'name 'fields (lambda () (list desc ...)))]))
- (define-syntax (defform* stx)
+ (define-syntax (defform*/subs stx)
(syntax-case stx ()
- [(_ [spec spec1 ...] desc ...)
+ [(_ [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
(with-syntax ([new-spec
(syntax-case #'spec ()
[(name . rest)
@@ -218,17 +219,32 @@
#'name)
#'rest)
#'spec)])])
- #'(*defforms #t '(spec spec1 ...)
+ #'(*defforms #t
+ '(spec spec1 ...)
(list (lambda (x) (schemeblock0 new-spec))
(lambda (ignored) (schemeblock0 spec1)) ...)
+ '((non-term-id non-term-form ...) ...)
+ (list (list (lambda () (scheme non-term-id))
+ (lambda () (schemeblock0 non-term-form))
+ ...)
+ ...)
(lambda () (list desc ...))))]))
+ (define-syntax (defform* stx)
+ (syntax-case stx ()
+ [(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)]))
(define-syntax (defform stx)
(syntax-case stx ()
- [(_ spec desc ...) #'(defform* [spec] desc ...)]))
+ [(_ spec desc ...) #'(defform*/subs [spec] () desc ...)]))
+ (define-syntax (defform/subs stx)
+ (syntax-case stx ()
+ [(_ spec subs desc ...) #'(defform*/subs [spec] subs desc ...)]))
(define-syntax (defform/none stx)
(syntax-case stx ()
[(_ spec desc ...)
- #'(*defforms #f '(spec) (list (lambda (ignored) (schemeblock0 spec))) (lambda () (list desc ...)))]))
+ #'(*defforms #f
+ '(spec) (list (lambda (ignored) (schemeblock0 spec)))
+ null null
+ (lambda () (list desc ...)))]))
(define-syntax specsubform
(syntax-rules ()
[(_ spec desc ...)
@@ -245,6 +261,9 @@
(syntax-rules ()
[(_ id result desc ...)
(*defthing 'id 'result (lambda () (list desc ...)))]))
+ (define-syntax schemegrammar
+ (syntax-rules ()
+ [(_ id clause ...) (*schemegrammar (scheme id) (schemeblock0 clause) ...)]))
(define-syntax var
(syntax-rules ()
[(_ id) (*var 'id)]))
@@ -450,12 +469,13 @@
(define (meta-symbol? s) (memq s '(... ...+ ?)))
- (define (*defforms kw? forms form-procs content-thunk)
+ (define (*defforms kw? forms form-procs subs sub-procs content-thunk)
(parameterize ([current-variable-list
(apply
append
(map (lambda (form)
- (let loop ([form (if kw? (cdr form) form)])
+ (let loop ([form (cons (if kw? (cdr form) form)
+ subs)])
(cond
[(symbol? form) (if (meta-symbol? form)
null
@@ -468,24 +488,32 @@
(cons
(make-table
'boxed
- (map (lambda (form form-proc)
- (list
- (make-flow
- (list
- ((or form-proc
- (lambda (x)
- (make-paragraph
- (list
- (to-element
- `(,x
- . ,(cdr form)))))))
- (and kw?
- (eq? form (car forms))
- (make-target-element
- #f
- (list (to-element (car form)))
- (register-scheme-form-definition (car form)))))))))
- forms form-procs))
+ (append
+ (map (lambda (form form-proc)
+ (list
+ (make-flow
+ (list
+ ((or form-proc
+ (lambda (x)
+ (make-paragraph
+ (list
+ (to-element
+ `(,x
+ . ,(cdr form)))))))
+ (and kw?
+ (eq? form (car forms))
+ (make-target-element
+ #f
+ (list (to-element (car form)))
+ (register-scheme-form-definition (car form)))))))))
+ forms form-procs)
+ (apply
+ append
+ (map (lambda (sub)
+ (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
+ (list (make-flow (list (apply *schemegrammar
+ (map (lambda (f) (f)) sub)))))))
+ sub-procs))))
(content-thunk)))))
(define (*specsubform form has-kw? form-thunk content-thunk)
@@ -512,6 +540,26 @@
(make-paragraph (list (to-element form)))))))))
(flow-paragraphs (decode-flow (content-thunk)))))))
+ (define (*schemegrammar nonterm clause1 . clauses)
+ (make-table
+ '((valignment baseline baseline baseline baseline baseline)
+ (alignment left left center left left))
+ (let ([empty-line (make-flow (list (make-paragraph (list (tt 'nbsp)))))]
+ [to-flow (lambda (i) (make-flow (list (make-paragraph (list i)))))])
+ (cons
+ (list (to-flow nonterm)
+ empty-line
+ (to-flow "=")
+ empty-line
+ (make-flow (list clause1)))
+ (map (lambda (clause)
+ (list empty-line
+ empty-line
+ (to-flow "|")
+ empty-line
+ (make-flow (list clause))))
+ clauses)))))
+
(define (*var id)
(to-element (*var-sym id)))
diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss
index b3555c3a..43476745 100644
--- a/collects/scribble/scheme.ss
+++ b/collects/scribble/scheme.ss
@@ -105,7 +105,10 @@
(set! col-map next-col-map)
(set! next-col-map (make-hash-table 'equal))
(init-line!))
- (let ([d-col (hash-table-get col-map c (+ dest-col (- c src-col)))])
+ (let ([d-col (let ([def-val (+ dest-col (- c src-col))])
+ (if new-line?
+ (hash-table-get col-map c def-val)
+ def-val))])
(let ([amt (- d-col dest-col)])
(when (positive? amt)
(let ([old-dest-col dest-col])