commit a8024d16ed2cff9b881b702d35395a2ea9fb416d
parent d5e244a068b98d087a69ff62a727ce2e43d89d86
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 10 Feb 2015 10:57:45 -0700
fix alignment of contracts for PDF output
Diffstat:
2 files changed, 54 insertions(+), 22 deletions(-)
diff --git a/scribble-lib/scribble/private/manual-proc.rkt b/scribble-lib/scribble/private/manual-proc.rkt
@@ -458,7 +458,8 @@
(make-flow
(if short?
;; The single-line case:
- (make-table-if-necessary
+ (top-align
+ make-table-if-necessary
"prototype"
(list
(cons
@@ -481,7 +482,8 @@
flow-spacer flow-spacer))]
[one-ok? (and (not (eq? mode 'new)) (tagged+arg-width . < . (- max-proto-width 5)))])
(list
- (make-table
+ (top-align
+ make-table
"prototype"
(cons
(cons
@@ -538,8 +540,10 @@
(loop ((if dots-next? cddr cdr)
args)))))))))))))))
(if result-next-line?
- (list (list (make-flow (make-table-if-necessary "prototype"
- (list end)))))
+ (list (list (make-flow (top-align
+ make-table-if-necessary
+ "prototype"
+ (list end)))))
null)
(append-map
(lambda (arg arg-contract arg-val)
@@ -563,21 +567,25 @@
(if (and (arg-optional? arg)
((+ base-len 3 def-len) . >= . max-proto-width))
(list
- (make-table
+ (top-align
+ make-table
"argcontract"
(list base-list (list flow-spacer flow-spacer flow-spacer
(to-flow "=") flow-spacer
(make-flow (list arg-val))))))
- (make-table-if-necessary
- "argcontract"
- (list
- (append
- base-list
- (if (and (arg-optional? arg)
- ((+ base-len 3 def-len) . < . max-proto-width))
- (list flow-spacer (to-flow "=") flow-spacer
- (make-flow (list arg-val)))
- null)))))))))]
+ (let ([show-default?
+ (and (arg-optional? arg)
+ ((+ base-len 3 def-len) . < . max-proto-width))])
+ (top-align
+ make-table-if-necessary
+ "argcontract"
+ (list
+ (append
+ base-list
+ (if show-default?
+ (list flow-spacer (to-flow "=") flow-spacer
+ (make-flow (list arg-val)))
+ null))))))))))]
[else null]))
args
arg-contracts
@@ -586,7 +594,8 @@
(let ([result-block (if (block? result-value)
result-value
(make-omitable-paragraph (list result-value)))])
- (list (list (list (make-table
+ (list (list (list (top-align
+ make-table
"argcontract"
(list (list
(to-flow (make-element #f (list spacer "=" spacer)))
@@ -637,6 +646,24 @@
([(id) boolean?] [(id [arg any/c]) void? #:value value.value])
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
@@ -980,7 +1007,8 @@
(cond
[(pair? v)
(list
- (make-table-if-necessary
+ (top-align
+ make-table-if-necessary
"argcontract"
(list (list (to-flow (hspace 2))
(to-flow (to-element (field-name v)))
@@ -1099,7 +1127,8 @@
(list
(list
((if (zero? i) (add-background-label (or kind "value")) values)
- (make-table-if-necessary
+ (top-align
+ make-table-if-necessary
"argcontract"
(append
(list
@@ -1118,14 +1147,16 @@
null))))))))
(if contract-on-first-line?
null
- (list (list (make-table-if-necessary
+ (list (list (top-align
+ make-table-if-necessary
"argcontract"
(list
(list (to-flow (list spacer ":" spacer))
(list contract-block)))))))
(if (or single-line? (not result-block))
null
- (list (list (make-table-if-necessary
+ (list (list (top-align
+ make-table-if-necessary
"argcontract"
(list (list
(to-flow (list spacer "=" spacer))
diff --git a/scribble-lib/scribble/private/manual-utils.rkt b/scribble-lib/scribble/private/manual-utils.rkt
@@ -2,7 +2,8 @@
(require "../struct.rkt"
"../base.rkt"
(only-in "../core.rkt"
- content?)
+ content?
+ style?)
racket/contract/base
scheme/list)
@@ -13,7 +14,7 @@
[flow-spacer flow?]
[flow-spacer/n (-> exact-nonnegative-integer? 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?)])
(define spacer (hspace 1))
