suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

scribble/manual: improve defstruct layout

Browse Source 
The old layout used column spans that created ugly space around parentheses
for some combinations of field-name and keyword-modifier lengths. The new
layot avoids the problem by breaking the keyword modifiers into their
own table.

original commit: a391556faa2d2b43f39b2d48a139085704a865ec
This commit is contained in:
Matthew Flatt 2014-01-15 09:03:40 -07:00
parent 1665fec8c2
commit ca59988ba0
1 changed files with 136 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -732,13 +732,18 @@
(string->symbol (format "make-~a" (syntax-e name-id))) (string->symbol (format "make-~a" (syntax-e name-id)))
name-id name-id
name-id))])) name-id))]))
(define keyword-modifiers? (or (not immutable?)
transparent?
cname-id))
(define keyword-spacer (hspace 4)) ; 2 would match DrRacket indentation, but 4 looks better with field contracts after
(define main-table (define main-table
(make-table (make-table
boxed-style boxed-style
(cons (append
;; First line in "boxed" table is struct name and fields:
(list
(list (list
((add-background-label "struct") ((add-background-label "struct")
(make-flow
(list (list
(let* ([the-name (let* ([the-name
(let ([just-name (let ([just-name
@ -796,7 +801,9 @@
[sym-length (lambda (s) [sym-length (lambda (s)
(string-length (symbol->string s)))] (string-length (symbol->string s)))]
[short-width [short-width
(apply + (length fields) 8 (apply +
(length fields) ; spaces between field names
8 ; "struct" + "(" + ")"
(append (append
(map sym-length (map sym-length
(append (if (pair? name) name (list name)) (append (if (pair? name) name (list name))
@ -808,24 +815,21 @@
0)) 0))
fields)))]) fields)))])
(if (and (short-width . < . max-proto-width) (if (and (short-width . < . max-proto-width)
immutable? (not keyword-modifiers?))
(not transparent?) ;; All on one line:
(not cname-id))
(make-omitable-paragraph (make-omitable-paragraph
(list (list
(to-element (to-element
`(,(racket struct) `(,(racket struct)
,the-name ,the-name
,(map field-view fields))))) ,(map field-view fields)))))
;; Multi-line view (leaving out last paren if keywords follow):
(let* ([one-right-column? (let* ([one-right-column?
;; Does the struct name and fields fit on a single line?
(or (null? fields) (or (null? fields)
(short-width . < . max-proto-width))] (short-width . < . max-proto-width))]
[a-right-column
(lambda (c)
(if one-right-column?
(list flow-spacer flow-spacer c)
(list flow-spacer flow-spacer c 'cont 'cont)))]
[split-field-line? [split-field-line?
;; start fields on the line after "struct"?
(max-proto-width . < . (+ 8 (max-proto-width . < . (+ 8
(if (pair? name) (if (pair? name)
(+ (sym-length (car name)) (+ (sym-length (car name))
@ -838,15 +842,12 @@
0) 0)
1))]) 1))])
(make-table (make-table
(if one-right-column?
#f #f
;; Shift all extra width to last column: ;; First four columns: "(struct" <space> <name><space> (
(make-style #f (list ;; If all fields on the first line, extra columns follow;
(make-table-columns ;; If only first field on same line, filds are in fourth column
(for/list ([i 5]) ;; If no field is on the first line, no fourth column after all
(if (i . < . 4) ;; and fields are in the second column
(make-style #f (list (column-attributes '((width . "0*")))))
(make-style #f null)))))))
(append (append
(list (list
(append (append
@ -856,21 +857,20 @@
(racket struct)))) (racket struct))))
flow-spacer) flow-spacer)
(if one-right-column? (if one-right-column?
(list (to-flow (make-element ;; struct name and fields on one line:
#f (list (to-flow (list the-name
(list* the-name
spacer spacer
(to-element (map field-view (to-element (map field-view
fields)) fields))
(if (and immutable? (if (and immutable?
(not transparent?) (not transparent?)
(not cname-id)) (not cname-id))
(list (racketparenfont ")")) (racketparenfont ")")
null))))) null))))
(if split-field-line? (if split-field-line?
(list (to-flow (make-element 'no-break the-name)) ;; Field start on line after "struct":
'cont (list (to-flow (make-element 'no-break the-name)))
'cont) ;; First field on the same line as "struct":
(list (to-flow (make-element 'no-break the-name)) (list (to-flow (make-element 'no-break the-name))
(to-flow (make-element (to-flow (make-element
#f (list spacer (racketparenfont "(")))) #f (list spacer (racketparenfont "("))))
@ -880,39 +880,45 @@
(list f (racketparenfont ")")) (list f (racketparenfont ")"))
f))))))))) f)))))))))
(if split-field-line? (if split-field-line?
;; First field, which starts on the next line:
(list (list
(list flow-spacer flow-spacer flow-spacer (list flow-spacer flow-spacer
(to-flow (make-element (to-flow (list
#f (list spacer (racketparenfont "(")))) (racketparenfont "(")
(to-flow (make-element 'no-break (make-element 'no-break
(let ([f (to-element (field-view (car fields)))]) (let ([f (to-element (field-view (car fields)))])
(if (null? (cdr fields)) (if (null? (cdr fields))
(list f (racketparenfont ")")) (list f (racketparenfont ")"))
f)))))) f)))))))
null) null)
(if (short-width . < . max-proto-width) ;; Remaining fields:
(if one-right-column?
null null
(let loop ([fields (if (null? fields) (let loop ([fields (if (null? fields)
fields (cdr fields))]) fields
(cdr fields))])
(if (null? fields) (if (null? fields)
null null
(cons (cons
(let ([fld (car fields)]) (let ([fld (car fields)])
(list flow-spacer flow-spacer (append
flow-spacer flow-spacer (list flow-spacer flow-spacer)
(to-flow (if split-field-line? null (list flow-spacer flow-spacer))
(list (to-flow
(list
(if split-field-line? spacer null)
(let ([e (to-element (field-view fld))]) (let ([e (to-element (field-view fld))])
(if (null? (cdr fields)) (if (null? (cdr fields))
(make-element (list e
#f (racketparenfont
(list e (racketparenfont
(if (and immutable? (if (and immutable?
(not transparent?) (not transparent?)
(not cname-id)) (not cname-id))
"))" "))"
")")))) ")")))
e))))) e)))))))
(loop (cdr fields)))))) (loop (cdr fields)))))))))))))))
;; Next lines at "boxed" level are construct-name keywords:
(if cname-id (if cname-id
(let ([kw (to-element (if (if cname-given? (let ([kw (to-element (if (if cname-given?
extra-cname? extra-cname?
@ -922,60 +928,58 @@
[nm (to-element cname-id)] [nm (to-element cname-id)]
[close? (and immutable? [close? (and immutable?
(not transparent?))]) (not transparent?))])
(if (max-proto-width . < . (+ 8 ; "(struct " (if (max-proto-width . < . (+ (element-width keyword-spacer)
1 ; space between kw & name 1 ; space between kw & name
(element-width kw) (element-width kw)
(element-width nm) (element-width nm)
(if close? 1 0))) (if close? 1 0)))
;; use two lines ;; use two lines for #:constructor-name
(list (a-right-column (to-flow kw)) (list (list (to-flow (list keyword-spacer kw)))
(a-right-column (list (to-flow
(to-flow (list
keyword-spacer
(if close? (if close?
(make-element #f (list nm (racketparenfont ")"))) (make-element #f (list nm (racketparenfont ")")))
nm)))) nm)))))
;; use one line ;; use one line for #:constructor-name
(list (a-right-column (list (list
(to-flow (make-element (to-flow (make-element
#f #f
(append (list
(list kw keyword-spacer
(hspace 1) kw (hspace 1) nm
nm)
(if close? (if close?
(list (racketparenfont ")")) (racketparenfont ")")
null)))))))) null))))))))
null) null)
;; Next lines at "boxed" level are prefab/transparent/mutable
(cond (cond
[(and (not immutable?) transparent?) [(and (not immutable?) transparent?)
(list (list
(a-right-column (to-flow (to-element '#:mutable))) (list (to-flow (list keyword-spacer (to-element '#:mutable))))
(a-right-column (to-flow (make-element (list (to-flow (list keyword-spacer
#f (if prefab?
(list (if prefab?
(to-element '#:prefab) (to-element '#:prefab)
(to-element '#:transparent)) (to-element '#:transparent))
(racketparenfont ")"))))))] (racketparenfont ")")))))]
[(not immutable?) [(not immutable?)
(list (list
(a-right-column (to-flow (make-element (list (to-flow (list keyword-spacer
#f (to-element '#:mutable)
(list (to-element '#:mutable) (racketparenfont ")")))))]
(racketparenfont ")"))))))]
[transparent? [transparent?
(list (list
(a-right-column (to-flow (make-element (list (to-flow (list keyword-spacer
#f (if prefab?
(list (if prefab?
(to-element '#:prefab) (to-element '#:prefab)
(to-element '#:transparent)) (to-element '#:transparent))
(racketparenfont ")"))))))] (racketparenfont ")")))))]
[else null])))))))))) [else null])
;; Remaining lines at "boxed" level are field contracts:
(map (lambda (v field-contract) (map (lambda (v field-contract)
(cond (cond
[(pair? v) [(pair? v)
(list (list
(make-flow
(make-table-if-necessary (make-table-if-necessary
"argcontract" "argcontract"
(list (list (to-flow (hspace 2)) (list (list (to-flow (hspace 2))
@ -983,7 +987,7 @@
flow-spacer flow-spacer
(to-flow ":") (to-flow ":")
flow-spacer flow-spacer
(make-flow (list (field-contract))))))))] (make-flow (list (field-contract)))))))]
[else null])) [else null]))
fields field-contracts)))) fields field-contracts))))
(make-box-splice (make-box-splice