suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

start on regexp functions; further formatting improvements for defproc

Browse Source 
svn: r6745

original commit: bf717526b0d76546793db9a52863547fbb030706
This commit is contained in:
Matthew Flatt 2007-06-27 00:17:04 +00:00
parent 4939c9cff0
commit c097769365
3 changed files with 158 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
collects/scribble/manual.ss
View File

@ -393,11 +393,12 @@
[(eq? v '...)
dots0]
[else v]))]
[prototype-size (lambda (s)
(let loop ([s s])
[prototype-size (lambda (s first-combine next-combine)
(let loop ([s s][combine first-combine])
(if (null? s)
1
(+ 1 (loop (cdr s))
0
(combine
(loop (cdr s) next-combine)
(cond
[(symbol? (car s)) (string-length (symbol->string (car s)))]
[(pair? (car s))
@ -422,10 +423,7 @@
append
(map
(lambda (stx-id prototype arg-contracts result-contract first?)
(append
(list
(list (make-flow
(let-values ([(required optional more-required)
(let*-values ([(required optional more-required)
(let loop ([a (cdr prototype)][r-accum null])
(if (or (null? a)
(and (has-optional? (car a))))
@ -444,12 +442,22 @@
(register-scheme-definition stx-id))
(to-element (make-just-context (car prototype)
stx-id)))]
[(short?) (or ((prototype-size prototype) . < . 40)
[(flat-size) (prototype-size prototype + +)]
[(short?) (or (flat-size . < . 40)
((length prototype) . < . 3))]
[(res) (result-contract)]
[(result-next-line?) ((+ (if short?
flat-size
(prototype-size prototype + max))
(flow-element-width res))
. >= . 50)]
[(end) (list (to-flow spacer)
(to-flow 'rarr)
(to-flow spacer)
(make-flow (list (result-contract))))])
(make-flow (list res)))])
(append
(list
(list (make-flow
(if short?
(make-table-if-necessary
"prototype"
@ -468,12 +476,16 @@
'paren-shape
#\?))))
(map arg->elem more-required))))
end)))
(if result-next-line?
null
end))))
(let ([not-end
(if result-next-line?
(list (to-flow spacer))
(list (to-flow spacer)
(to-flow spacer)
(to-flow spacer)
(to-flow spacer))])
(to-flow spacer)))])
(list
(make-table
"prototype"
@ -513,10 +525,16 @@
#f
(list a "]" (schemeparenfont ")"))))]
[else a])))
(if (null? (cdr args))
(if (and (null? (cdr args))
(not result-next-line?))
end
not-end))
(loop (cdr args) (sub1 req))))))))))))))
(loop (cdr args) (sub1 req)))))))))))))
(if result-next-line?
(list (list (make-flow (make-table-if-necessary
"prototype"
(list end)))))
null)
(apply append
(map (lambda (v arg-contract)
(cond
@ -546,7 +564,7 @@
null))))))))]
[else null]))
(cdr prototype)
arg-contracts))))
arg-contracts)))))
stx-ids
prototypes
arg-contractss

3
collects/scribble/scheme.ss
View File

@ -372,7 +372,8 @@
(make-link-element "schemesyntaxlink" (list s) stag)]
[vd
(make-link-element "schemevaluelink" (list s) vtag)]
[else s])))))
[else s]))))
(lambda () s))
(literalize-spaces s))
(cond
[(positive? quote-depth) value-color]

68
collects/scribble/struct.ss
View File

@ -95,28 +95,33 @@
delayed-element-ref
delayed-element-set!)
(make-struct-type 'delayed-element #f
1 1 #f
2 1 #f
(list (cons prop:serializable
(make-serialize-info
(lambda (d)
(unless (delayed-element-ref d 1)
(unless (delayed-element-ref d 2)
(error 'serialize-delayed-element
"cannot serialize a delayed element that was not resolved: ~e"
d))
(vector (delayed-element-ref d 1)))
(vector (delayed-element-ref d 2)))
#'deserialize-delayed-element
#f
(or (current-load-relative-directory) (current-directory)))))))
(define-syntax delayed-element (list-immutable #'struct:delayed-element
#'make-delayed-element
#'delayed-element?
(list-immutable #'delayed-element-render)
(list-immutable #'set-delayed-element-render!)
(list-immutable #'delayed-element-sizer
#'delayed-element-render)
(list-immutable #'set-delayed-element-sizer!
#'set-delayed-element-render!)
#t))
(define delayed-element-render (make-struct-field-accessor delayed-element-ref 0))
(define delayed-element-sizer (make-struct-field-accessor delayed-element-ref 1))
(define set-delayed-element-render! (make-struct-field-mutator delayed-element-set! 0))
(define set-delayed-element-sizer! (make-struct-field-mutator delayed-element-set! 1))
(provide/contract
(struct delayed-element ([render (any/c part? any/c . -> . list?)])))
(struct delayed-element ([render (any/c part? any/c . -> . list?)]
[sizer (-> any)])))
(provide deserialize-delayed-element)
(define deserialize-delayed-element
@ -124,9 +129,9 @@
(provide force-delayed-element)
(define (force-delayed-element d renderer sec ht)
(or (delayed-element-ref d 1)
(or (delayed-element-ref d 2)
(let ([v ((delayed-element-ref d 0) renderer sec ht)])
(delayed-element-set! d 1 v)
(delayed-element-set! d 2 v)
v)))
;; ----------------------------------------
@ -163,5 +168,52 @@
renderer sec ht)]
[else (element->string c)])]))
;; ----------------------------------------
(provide flow-element-width
element-width)
(define (element-width s)
(cond
[(string? s) (string-length s)]
[(element? s) (apply + (map element-width (element-content s)))]
[(delayed-element? s) (element-width ((delayed-element-sizer s)))]
[else 1]))
(define (paragraph-width s)
(apply + (map element-width (paragraph-content s))))
(define (flow-width f)
(apply max 0 (map flow-element-width (flow-paragraphs f))))
(define (flow-element-width p)
(cond
[(paragraph? p) (paragraph-width p)]
[(table? p) (table-width p)]
[(itemization? p) (itemization-width p)]
[(blockquote? p) (blockquote-width p)]
[(delayed-flow-element? p) 1]))
(define (table-width p)
(let ([flowss (table-flowss p)])
(if (null? flowss)
0
(let loop ([flowss flowss])
(if (null? (car flowss))
0
(+ (apply max
0
(map flow-width
(map car flowss)))
(loop (map cdr flowss))))))))
(define (itemization-width p)
(apply max 0 (map flow-width (itemization-flows p))))
(define (blockquote-width p)
(+ 4 (apply max 0 (map paragraph-width (blockquote-paragraphs p)))))
;; ----------------------------------------
)