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

fix alignment of contracts for PDF output

Browse Source
This commit is contained in:
Matthew Flatt 2015-02-10 10:57:45 -07:00
parent d5e244a068
commit a8024d16ed
2 changed files with 54 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
scribble-lib/scribble/private/manual-proc.rkt
View File

@ -458,7 +458,8 @@
(make-flow (make-flow
(if short? (if short?
;; The single-line case: ;; The single-line case:
(make-table-if-necessary (top-align
make-table-if-necessary
"prototype" "prototype"
(list (list
(cons (cons
@ -481,7 +482,8 @@
flow-spacer flow-spacer))] flow-spacer flow-spacer))]
[one-ok? (and (not (eq? mode 'new)) (tagged+arg-width . < . (- max-proto-width 5)))]) [one-ok? (and (not (eq? mode 'new)) (tagged+arg-width . < . (- max-proto-width 5)))])
(list (list
(make-table (top-align
make-table
"prototype" "prototype"
(cons (cons
(cons (cons
@ -538,8 +540,10 @@
(loop ((if dots-next? cddr cdr) (loop ((if dots-next? cddr cdr)
args))))))))))))))) args)))))))))))))))
(if result-next-line? (if result-next-line?
(list (list (make-flow (make-table-if-necessary "prototype" (list (list (make-flow (top-align
(list end))))) make-table-if-necessary
"prototype"
(list end)))))
null) null)
(append-map (append-map
(lambda (arg arg-contract arg-val) (lambda (arg arg-contract arg-val)
@ -563,21 +567,25 @@
(if (and (arg-optional? arg) (if (and (arg-optional? arg)
((+ base-len 3 def-len) . >= . max-proto-width)) ((+ base-len 3 def-len) . >= . max-proto-width))
(list (list
(make-table (top-align
make-table
"argcontract" "argcontract"
(list base-list (list flow-spacer flow-spacer flow-spacer (list base-list (list flow-spacer flow-spacer flow-spacer
(to-flow "=") flow-spacer (to-flow "=") flow-spacer
(make-flow (list arg-val)))))) (make-flow (list arg-val))))))
(make-table-if-necessary (let ([show-default?
"argcontract" (and (arg-optional? arg)
(list ((+ base-len 3 def-len) . < . max-proto-width))])
(append (top-align
base-list make-table-if-necessary
(if (and (arg-optional? arg) "argcontract"
((+ base-len 3 def-len) . < . max-proto-width)) (list
(list flow-spacer (to-flow "=") flow-spacer (append
(make-flow (list arg-val))) base-list
null)))))))))] (if show-default?
(list flow-spacer (to-flow "=") flow-spacer
(make-flow (list arg-val)))
null))))))))))]
[else null])) [else null]))
args args
arg-contracts arg-contracts
@ -586,7 +594,8 @@
(let ([result-block (if (block? result-value) (let ([result-block (if (block? result-value)
result-value result-value
(make-omitable-paragraph (list result-value)))]) (make-omitable-paragraph (list result-value)))])
(list (list (list (make-table (list (list (list (top-align
make-table
"argcontract" "argcontract"
(list (list (list (list
(to-flow (make-element #f (list spacer "=" spacer))) (to-flow (make-element #f (list spacer "=" spacer)))
@ -637,6 +646,24 @@
([(id) boolean?] [(id [arg any/c]) void? #:value value.value]) ([(id) boolean?] [(id [arg any/c]) void? #:value value.value])
desc ...)])) desc ...)]))
(define top-align-styles (make-hash))
(define (top-align make-table style-name cols)
(if (null? cols)
(make-table style-name null)
(let* ([n (length (car cols))]
[k (cons style-name n)])
(make-table
(hash-ref top-align-styles
k
(lambda ()
(define s
(make-style style-name
(list (make-table-columns (for/list ([i n])
(make-style #f '(top)))))))
(hash-set! top-align-styles k s)
s))
cols))))
;; ---------------------------------------- ;; ----------------------------------------
(begin-for-syntax (begin-for-syntax
@ -980,7 +1007,8 @@
(cond (cond
[(pair? v) [(pair? v)
(list (list
(make-table-if-necessary (top-align
make-table-if-necessary
"argcontract" "argcontract"
(list (list (to-flow (hspace 2)) (list (list (to-flow (hspace 2))
(to-flow (to-element (field-name v))) (to-flow (to-element (field-name v)))
@ -1099,7 +1127,8 @@
(list (list
(list (list
((if (zero? i) (add-background-label (or kind "value")) values) ((if (zero? i) (add-background-label (or kind "value")) values)
(make-table-if-necessary (top-align
make-table-if-necessary
"argcontract" "argcontract"
(append (append
(list (list
@ -1118,14 +1147,16 @@
null)))))))) null))))))))
(if contract-on-first-line? (if contract-on-first-line?
null null
(list (list (make-table-if-necessary (list (list (top-align
make-table-if-necessary
"argcontract" "argcontract"
(list (list
(list (to-flow (list spacer ":" spacer)) (list (to-flow (list spacer ":" spacer))
(list contract-block))))))) (list contract-block)))))))
(if (or single-line? (not result-block)) (if (or single-line? (not result-block))
null null
(list (list (make-table-if-necessary (list (list (top-align
make-table-if-necessary
"argcontract" "argcontract"
(list (list (list (list
(to-flow (list spacer "=" spacer)) (to-flow (list spacer "=" spacer))

5
scribble-lib/scribble/private/manual-utils.rkt
View File

@ -2,7 +2,8 @@
(require "../struct.rkt" (require "../struct.rkt"
"../base.rkt" "../base.rkt"
(only-in "../core.rkt" (only-in "../core.rkt"
content?) content?
style?)
racket/contract/base racket/contract/base
scheme/list) scheme/list)
@ -13,7 +14,7 @@
[flow-spacer flow?] [flow-spacer flow?]
[flow-spacer/n (-> exact-nonnegative-integer? flow?)] [flow-spacer/n (-> exact-nonnegative-integer? flow?)]
[flow-empty-line flow?] [flow-empty-line flow?]
[make-table-if-necessary (content? list? . -> . (list/c (or/c omitable-paragraph? table?)))] [make-table-if-necessary ((or/c style? string?) list? . -> . (list/c (or/c omitable-paragraph? table?)))]
[current-display-width (parameter/c exact-nonnegative-integer?)]) [current-display-width (parameter/c exact-nonnegative-integer?)])
(define spacer (hspace 1)) (define spacer (hspace 1))