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

scribble/manual: break defthing output lines if needed

Browse Source 
If the defined identifier plus contract doesn't fit on a single
line, put them on separate lines.

original commit: 77392cd02752d868e1c8363779ada62b9431df7f
This commit is contained in:
Matthew Flatt 2014-01-15 07:32:02 -07:00
parent db1a3b4139
commit 1665fec8c2
1 changed files with 70 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt
View File

@ -479,7 +479,7 @@
(list flow-spacer) (list flow-spacer)
(list flow-spacer flow-spacer (list flow-spacer flow-spacer
flow-spacer flow-spacer))] flow-spacer flow-spacer))]
[one-ok? (and (not (eq? mode 'new)) (tagged+arg-width . < . 60))]) [one-ok? (and (not (eq? mode 'new)) (tagged+arg-width . < . (- max-proto-width 5)))])
(list (list
(make-table (make-table
"prototype" "prototype"
@ -1030,6 +1030,7 @@
(define (*defthing kind link? stx-ids names form? result-contracts content-thunk (define (*defthing kind link? stx-ids names form? result-contracts content-thunk
[result-values (map (lambda (x) #f) result-contracts)]) [result-values (map (lambda (x) #f) result-contracts)])
(define max-proto-width (current-display-width))
(make-box-splice (make-box-splice
(cons (cons
(make-blockquote (make-blockquote
@ -1052,28 +1053,14 @@
(if (block? result-contract) (if (block? result-contract)
result-contract result-contract
(make-omitable-paragraph (list result-contract)))] (make-omitable-paragraph (list result-contract)))]
[total-width (+ (string-length (format "~a" name)) [name+contract-width (+ (string-length (format "~a" name))
3 3
(block-width contract-block) (block-width contract-block))]
[total-width (+ name+contract-width
(if result-block (if result-block
(+ (block-width result-block) 3) (+ (block-width result-block) 3)
0))]) 0))]
(append [thing-id (let ([target-maker
(list
(list
((if (zero? i) (add-background-label (or kind "value")) values)
(make-flow
(make-table-if-necessary
"argcontract"
(append
(list
(append
(list
(make-flow
(list
(make-omitable-paragraph
(list
(let ([target-maker
(and link? (and link?
((if form? id-to-form-target-maker id-to-target-maker) ((if form? id-to-form-target-maker id-to-target-maker)
stx-id #t))]) stx-id #t))])
@ -1099,29 +1086,46 @@
(lambda (libs) (make-thing-index-desc name libs)))) (lambda (libs) (make-thing-index-desc name libs))))
tag tag
ref-content))) ref-content)))
content)))))) content))]
(make-flow [contract-on-first-line? (name+contract-width . < . max-proto-width)]
[single-line? (and contract-on-first-line?
(total-width . < . max-proto-width)
(not (table? result-value)))])
(append
(list (list
(make-omitable-paragraph
(list (list
spacer ":" spacer)))) ((if (zero? i) (add-background-label (or kind "value")) values)
(make-flow (list contract-block))) (make-table-if-necessary
(if (and result-value "argcontract"
(and (total-width . < . 60) (append
(not (table? result-value))))
(list (list
(to-flow (make-element #f (list spacer "=" spacer))) (append
(make-flow (list result-block))) (list (list (make-omitable-paragraph
null))))))))) (list thing-id))))
(if (and result-value (if contract-on-first-line?
(or (total-width . >= . 60) (list
(table? result-value))) (to-flow (list spacer ":" spacer))
(list (list (list (make-table (list contract-block))
null)
(if (and result-block single-line?)
(list
(to-flow (list spacer "=" spacer))
(list result-block))
null))))))))
(if contract-on-first-line?
null
(list (list (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
"argcontract" "argcontract"
(list (list (list (list
(to-flow (make-element #f (list spacer "=" spacer))) (to-flow (list spacer "=" spacer))
(make-flow (list result-block)))))))) (list result-block))))))))))))))
null))))))))
(content-thunk)))) (content-thunk))))
(define (defthing/proc kind id contract descs) (define (defthing/proc kind id contract descs)