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

136
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,77 +1053,80 @@
(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))]
[thing-id (let ([target-maker
(and link?
((if form? id-to-form-target-maker id-to-target-maker)
stx-id #t))])
(define-values (content ref-content)
(if link?
(definition-site name stx-id form?)
(let ([s (make-just-context name stx-id)])
(values (to-element #:defn? #t s)
(to-element s)))))
(if target-maker
(target-maker
content
(lambda (tag)
(make-toc-target2-element
#f
(make-index-element
#f
content
tag
(list (datum-intern-literal (symbol->string name)))
(list ref-content)
(with-exporting-libraries
(lambda (libs) (make-thing-index-desc name libs))))
tag
ref-content)))
content))]
[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 (append
(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-flow (make-table-if-necessary
(make-table-if-necessary "argcontract"
"argcontract" (append
(append (list
(list (append
(append (list (list (make-omitable-paragraph
(list (list thing-id))))
(make-flow (if contract-on-first-line?
(list (list
(make-omitable-paragraph (to-flow (list spacer ":" spacer))
(list (list contract-block))
(let ([target-maker null)
(and link? (if (and result-block single-line?)
((if form? id-to-form-target-maker id-to-target-maker) (list
stx-id #t))]) (to-flow (list spacer "=" spacer))
(define-values (content ref-content) (list result-block))
(if link? null))))))))
(definition-site name stx-id form?) (if contract-on-first-line?
(let ([s (make-just-context name stx-id)]) null
(values (to-element #:defn? #t s) (list (list (make-table-if-necessary
(to-element s))))) "argcontract"
(if target-maker (list
(target-maker (list (to-flow (list spacer ":" spacer))
content (list contract-block)))))))
(lambda (tag) (if (or single-line? (not result-block))
(make-toc-target2-element null
#f (list (list (make-table-if-necessary
(make-index-element "argcontract"
#f (list (list
content (to-flow (list spacer "=" spacer))
tag (list result-block))))))))))))))
(list (datum-intern-literal (symbol->string name))) (content-thunk))))
(list ref-content)
(with-exporting-libraries
(lambda (libs) (make-thing-index-desc name libs))))
tag
ref-content)))
content))))))
(make-flow
(list
(make-omitable-paragraph
(list
spacer ":" spacer))))
(make-flow (list contract-block)))
(if (and result-value
(and (total-width . < . 60)
(not (table? result-value))))
(list
(to-flow (make-element #f (list spacer "=" spacer)))
(make-flow (list result-block)))
null)))))))))
(if (and result-value
(or (total-width . >= . 60)
(table? result-value)))
(list (list (list (make-table
"argcontract"
(list (list
(to-flow (make-element #f (list spacer "=" spacer)))
(make-flow (list result-block))))))))
null))))))))
(content-thunk))))
(define (defthing/proc kind id contract descs) (define (defthing/proc kind id contract descs)
(*defthing kind #t (list id) (list (syntax-e id)) #f (list contract) (*defthing kind #t (list id) (list (syntax-e id)) #f (list contract)