add make-numberer to generalize section numbering
This commit is contained in:
Matthew Flatt
parent
2881ef290d
commit
798155c4f9
|
|
@ -396,10 +396,19 @@ The recognized @tech{style properties} are as follows:
|
|||
@racket['hidden] (for consistency in non-Latex output).}
|
||||
|
||||
@item{@racket['grouper] --- The part is numbered with a Roman
|
||||
numeral, and its subsections continue numbering as if they
|
||||
appeared in the preceeding part. In other words, the part acts
|
||||
like a ``part'' in a book where chapter numbering is continuous
|
||||
across parts.}
|
||||
numeral, by default, and its subsections continue numbering as
|
||||
if they appeared in the preceeding part. In other words, the
|
||||
part acts like a ``part'' in a book where chapter numbering is
|
||||
continuous across parts.}
|
||||
|
||||
@item{@tech{numberer} --- A @tech{numberer} created with
|
||||
@racket[make-numberer] determines a representation of the
|
||||
part's section number as an extension of it's patent's number.
|
||||
A @tech{numberer} overrides the default representation, which
|
||||
is a natural number or (in the case of an accompanying
|
||||
@racket['grouper] property) a Roman numeral. If a
|
||||
@racket['unnumbered] property is also present, a
|
||||
@tech{numberer} property is ignored.}
|
||||
|
||||
@item{@racket['toc] --- Sub-parts of the part are rendered on separate
|
||||
pages for multi-page HTML mode.}
|
||||
|
|
@ -1076,18 +1085,42 @@ If a @racket[render-element] instance is serialized (such as when
|
|||
saving collected info), it is reduced to a @racket[element] instance.}
|
||||
|
||||
|
||||
@defstruct[collected-info ([number (listof (or/c #f exact-nonnegative-integer? string?))]
|
||||
@defstruct[collected-info ([number (listof part-number-item?)]
|
||||
[parent (or/c #f part?)]
|
||||
[info any/c])]{
|
||||
|
||||
Computed for each part by the @techlink{collect pass}.
|
||||
|
||||
The length of the @racket[number] list indicates the section's nesting
|
||||
depth. Numbers in @racket[number] correspond to the section's number,
|
||||
it's parent's number, etc. A non-empty string is used for a
|
||||
@racket['grouper] section. For an unnumbered section, @racket[#f] is
|
||||
used in place of all numbers and @racket[""] in place of all non-empty
|
||||
strings.}
|
||||
depth. Elements of @racket[number] correspond to the section's number,
|
||||
it's parent's number, and so on (that is, the section numbers are in
|
||||
reverse order):
|
||||
|
||||
@itemlist[
|
||||
|
||||
@item{A number value corresponds to a normally numbered
|
||||
section.}
|
||||
|
||||
@item{A non-empty string corresponds to a @racket['grouper] section,
|
||||
which is shown as part of the combined section number only when
|
||||
it's the first element.}
|
||||
|
||||
@item{A a list corresponds to a @tech{numberer}-generated section
|
||||
string plus its separator string, where the separator is used
|
||||
in a combined section number after the section string and
|
||||
before a subsection's number (or, for some output modes, before
|
||||
the title of the section).}
|
||||
|
||||
@item{For an unnumbered section, a @racket[#f] is used in place of
|
||||
any number or lists element, while @racket[""] is used in place
|
||||
of all non-empty strings.}
|
||||
|
||||
]}
|
||||
|
||||
@history[#:changed "6.4" @elem{Added @racket[(list/c string? string?)]
|
||||
number items for
|
||||
@tech{numberer}-generated section
|
||||
numbers.}]}
|
||||
|
||||
|
||||
@defstruct[target-url ([addr path-string?])]{
|
||||
|
|
@ -1313,6 +1346,61 @@ Returns the width in characters of the given @tech{content}.
|
|||
Returns the width in characters of the given @tech{block}.}
|
||||
|
||||
|
||||
@defproc[(part-number-item? [v any/c]) boolean]{
|
||||
|
||||
Return @racket[#t] if @racket[v] is @racket[#f], an exact non-negative
|
||||
integer, a string, or a list containing two strings. See @racket[part]
|
||||
for information on how different representations are used for numbering.
|
||||
|
||||
@history[#:added "6.4"]}
|
||||
|
||||
|
||||
@deftogether[(
|
||||
@defproc[(numberer? [v any/c]) boolean?]
|
||||
@defproc[(make-numberer [step (any/c (listof part-number-item?)
|
||||
. -> .
|
||||
(values part-number-item? any/c))]
|
||||
[initial-value any/c])
|
||||
numberer?]
|
||||
@defproc[(numberer-step [n numberer?]
|
||||
[parent-number (listof part-number-item?)]
|
||||
[ci collect-info?]
|
||||
[numberer-values hash?])
|
||||
(values part-number-item? hash?)]
|
||||
)]{
|
||||
|
||||
A @deftech{numberer} implements a representation of a section number
|
||||
that increment separately from the default numbering style and that
|
||||
can be rendered differently than as Arabic numerals.
|
||||
|
||||
The @racket[numberer?] function returns @racket[#t] if @racket[v] is a
|
||||
@tech{numberer}, or @racket[#f] otherwise.
|
||||
|
||||
The @racket[make-numberer] function creates a @tech{numberer}. The
|
||||
@racket[step] function computes both the current number's
|
||||
representation and increments the number, where the ``number'' can be
|
||||
an arbitrary value; the @racket[initial-value] argument determines the
|
||||
initial value of the ``number'', and the @racket[step] function
|
||||
receives the current value as its first argument and returns an
|
||||
incremented value as its second result. A numberer's ``number'' value
|
||||
starts fresh at each new nesting level. In addition to the numberer's
|
||||
current value, the @racket[step] function receives the parent
|
||||
section's numbering (so that its result can depend on the part's
|
||||
nesting depth).
|
||||
|
||||
The @racket[numberer-step] function is normally used by a renderer. It
|
||||
applies a @tech{numberer}, given the parent section's number, a
|
||||
@racket[collect-info] value, and a hash table that accumulates
|
||||
@tech{numberer} values at a given nesting layer. The
|
||||
@racket[collect-info] argument is needed because a @tech{numberer}'s
|
||||
identity is based on a @racket[generated-tag]. The result of
|
||||
@racket[numberer-step] is the rendered form of the current section
|
||||
number plus an updated hash table with an incremented value for the
|
||||
@tech{numberer}.
|
||||
|
||||
@history[#:added "6.4"]}
|
||||
|
||||
|
||||
@defstruct[collect-info ([fp any/c] [ht any/c] [ext-ht any/c]
|
||||
[ext-demand (tag? collect-info? . -> . any/c)]
|
||||
[parts any/c]
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@
|
|||
(define/public (index-manual-newlines?)
|
||||
#f)
|
||||
|
||||
(define/public (format-number number sep)
|
||||
(define/public (format-number number sep [keep-separator? #f])
|
||||
(if (or (null? number)
|
||||
(andmap (lambda (x) (or (not x) (equal? x "")))
|
||||
number)
|
||||
|
|
@ -81,13 +81,25 @@
|
|||
(cons (let ([s (string-append
|
||||
(apply
|
||||
string-append
|
||||
(map (lambda (n) (if (number? n) (format "~a." n) ""))
|
||||
(map (lambda (n)
|
||||
(cond
|
||||
[(number? n) (format "~a." n)]
|
||||
[(or (not n) (string? n)) ""]
|
||||
[(pair? n) (string-append (car n) (cadr n))]))
|
||||
(reverse (cdr number))))
|
||||
(if (and (car number)
|
||||
(not (equal? "" (car number))))
|
||||
(format "~a." (car number))
|
||||
(if (pair? (car number))
|
||||
(if keep-separator?
|
||||
(string-append (caar number)
|
||||
(cadar number))
|
||||
(caar number))
|
||||
(format "~a." (car number)))
|
||||
""))])
|
||||
(substring s 0 (sub1 (string-length s))))
|
||||
(if (or keep-separator?
|
||||
(pair? (car number)))
|
||||
s
|
||||
(substring s 0 (sub1 (string-length s)))))
|
||||
sep)))
|
||||
|
||||
(define/public (number-depth number)
|
||||
|
|
@ -501,10 +513,10 @@
|
|||
ci))
|
||||
|
||||
(define/public (start-collect ds fns ci)
|
||||
(map (lambda (d) (collect-part d #f ci null 1))
|
||||
(for-each (lambda (d) (collect-part d #f ci null 1 #hash()))
|
||||
ds))
|
||||
|
||||
(define/public (collect-part d parent ci number init-sub-number)
|
||||
(define/public (collect-part d parent ci number init-sub-number init-sub-numberers)
|
||||
(let ([p-ci (make-collect-info
|
||||
(collect-info-fp ci)
|
||||
(make-hash)
|
||||
|
|
@ -524,7 +536,7 @@
|
|||
parent
|
||||
(collect-info-ht p-ci)))
|
||||
(define grouper? (and (pair? number) (part-style? d 'grouper)))
|
||||
(define next-sub-number
|
||||
(define-values (next-sub-number next-sub-numberers)
|
||||
(parameterize ([current-tag-prefixes
|
||||
(extend-prefix d (fresh-tag-collect-context? d p-ci))])
|
||||
(when (part-title-content d)
|
||||
|
|
@ -534,37 +546,54 @@
|
|||
(collect-flow (part-blocks d) p-ci)
|
||||
(let loop ([parts (part-parts d)]
|
||||
[pos init-sub-number]
|
||||
[sub-pos 1])
|
||||
[numberers init-sub-numberers]
|
||||
[sub-pos 1]
|
||||
[sub-numberers #hash()])
|
||||
(if (null? parts)
|
||||
pos
|
||||
(values pos numberers)
|
||||
(let ([s (car parts)])
|
||||
(define unnumbered? (part-style? s 'unnumbered))
|
||||
(define hidden-number? (or unnumbered?
|
||||
(part-style? s 'hidden-number)))
|
||||
(define sub-grouper? (part-style? s 'grouper))
|
||||
(define next-sub-pos
|
||||
(define numberer (and (not unnumbered?)
|
||||
(for/or ([p (style-properties (part-style s))]
|
||||
#:when (numberer? p))
|
||||
p)))
|
||||
(define-values (numberer-str next-numberers)
|
||||
(if numberer
|
||||
(numberer-step numberer number p-ci numberers)
|
||||
(values #f numberers)))
|
||||
(define-values (next-sub-pos next-sub-numberers)
|
||||
(collect-part s d p-ci
|
||||
(cons (if hidden-number?
|
||||
(if sub-grouper?
|
||||
""
|
||||
#f)
|
||||
(if numberer
|
||||
numberer-str
|
||||
(if sub-grouper?
|
||||
(number->roman pos)
|
||||
pos))
|
||||
pos)))
|
||||
(if hidden-number?
|
||||
(for/list ([i (in-list number)])
|
||||
(if (string? i)
|
||||
i
|
||||
#f))
|
||||
number))
|
||||
sub-pos))
|
||||
sub-pos
|
||||
sub-numberers))
|
||||
(loop (cdr parts)
|
||||
(if unnumbered?
|
||||
(if (or unnumbered? numberer)
|
||||
pos
|
||||
(add1 pos))
|
||||
next-numberers
|
||||
(if sub-grouper?
|
||||
next-sub-pos
|
||||
1)))))))
|
||||
1)
|
||||
(if sub-grouper?
|
||||
next-sub-numberers
|
||||
#hash())))))))
|
||||
(let ([prefix (part-tag-prefix d)])
|
||||
(for ([(k v) (collect-info-ht p-ci)])
|
||||
(when (cadr k)
|
||||
|
|
@ -572,7 +601,7 @@
|
|||
(convert-key prefix k)
|
||||
k)
|
||||
v))))
|
||||
next-sub-number))
|
||||
(values next-sub-number next-sub-numberers)))
|
||||
|
||||
(define/private (convert-key prefix k)
|
||||
(case (car k)
|
||||
|
|
|
|||
|
|
@ -160,6 +160,57 @@
|
|||
(andmap (λ (l) (= l1 (length l)))
|
||||
(cdr ls)))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define-struct numberer (tag step-proc initial-value)
|
||||
#:constructor-name numberer
|
||||
#:property
|
||||
prop:serializable
|
||||
(make-serialize-info
|
||||
(lambda (d)
|
||||
(vector (numberer-tag d)
|
||||
(numberer-initial-value d)))
|
||||
#'deserialize-numberer
|
||||
#f
|
||||
(or (current-load-relative-directory) (current-directory))))
|
||||
|
||||
(provide deserialize-numberer)
|
||||
(define deserialize-numberer
|
||||
(make-deserialize-info (lambda (tag init-val)
|
||||
(numberer tag #f))
|
||||
(lambda (tag init-val)
|
||||
(error "cannot allocate numberer for cycle"))))
|
||||
|
||||
(define (make-numberer spec-proc initial-value)
|
||||
(numberer (generated-tag) spec-proc initial-value))
|
||||
|
||||
(define (numberer-step n parent-numbers ci ht)
|
||||
(define tag (generate-tag `(numberer ,(numberer-tag n)) ci))
|
||||
(define-values (numberer-str new-val)
|
||||
(let ([step (numberer-step-proc n)])
|
||||
(step (hash-ref ht tag (lambda () (numberer-initial-value n)))
|
||||
parent-numbers)))
|
||||
(values numberer-str (hash-set ht tag new-val)))
|
||||
|
||||
(define part-number-item?
|
||||
(or/c #f exact-nonnegative-integer? string? (list/c string? string?)))
|
||||
|
||||
(provide
|
||||
part-number-item?
|
||||
numberer?
|
||||
(contract-out
|
||||
[make-numberer ((any/c (listof part-number-item?)
|
||||
. -> . (values part-number-item? any/c))
|
||||
any/c
|
||||
. -> . numberer?)]
|
||||
[numberer-step (numberer?
|
||||
(listof part-number-item?)
|
||||
collect-info?
|
||||
hash?
|
||||
. -> . (values part-number-item? hash?))]))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(provide-structs
|
||||
[part ([tag-prefix (or/c false/c string?)]
|
||||
[tags (listof tag?)]
|
||||
|
|
@ -211,6 +262,7 @@
|
|||
[target-url ([addr path-string?])]
|
||||
[color-property ([color (or/c string? (list/c byte? byte? byte?))])]
|
||||
[background-color-property ([color (or/c string? (list/c byte? byte? byte?))])]
|
||||
[numberer-property ([numberer numberer?] [argument any/c])]
|
||||
|
||||
[table-columns ([styles (listof style?)])]
|
||||
[table-cells ([styless (listof (listof style?))])]
|
||||
|
|
@ -219,7 +271,7 @@
|
|||
[center-name string?]
|
||||
[bottom-name string?])]
|
||||
|
||||
[collected-info ([number (listof (or/c false/c exact-nonnegative-integer? string?))]
|
||||
[collected-info ([number (listof part-number-item?)]
|
||||
[parent (or/c false/c part?)]
|
||||
[info any/c])]
|
||||
|
||||
|
|
|
|||
|
|
@ -341,10 +341,10 @@
|
|||
;; ----------------------------------------
|
||||
|
||||
(define/override (start-collect ds fns ci)
|
||||
(map (lambda (d fn)
|
||||
(for-each (lambda (d fn)
|
||||
(parameterize ([current-output-file fn]
|
||||
[current-top-part d])
|
||||
(collect-part d #f ci null 1)))
|
||||
(collect-part d #f ci null 1 #hash())))
|
||||
ds
|
||||
fns))
|
||||
|
||||
|
|
@ -1906,7 +1906,7 @@
|
|||
|
||||
(define/override (start-collect ds fns ci)
|
||||
(parameterize ([current-part-files (make-hash)])
|
||||
(map (lambda (d fn)
|
||||
(for-each (lambda (d fn)
|
||||
(parameterize ([collecting-sub
|
||||
(if (part-style? d 'non-toc)
|
||||
1
|
||||
|
|
@ -1922,7 +1922,7 @@
|
|||
orig-s))
|
||||
(hash-set! (current-part-files) s #t)))
|
||||
|
||||
(define/override (collect-part d parent ci number sub-init-number)
|
||||
(define/override (collect-part d parent ci number sub-init-number sub-init-numberers)
|
||||
(let ([prev-sub (collecting-sub)])
|
||||
(parameterize ([collecting-sub (if (part-style? d 'toc)
|
||||
1
|
||||
|
|
@ -1936,8 +1936,8 @@
|
|||
(make-directory* (path-only full-filename))
|
||||
(check-duplicate-filename full-filename)
|
||||
(parameterize ([current-output-file full-filename])
|
||||
(super collect-part d parent ci number sub-init-number)))
|
||||
(super collect-part d parent ci number sub-init-number)))))
|
||||
(super collect-part d parent ci number sub-init-number sub-init-numberers)))
|
||||
(super collect-part d parent ci number sub-init-number sub-init-numberers)))))
|
||||
|
||||
(define/override (render-top ds fns ri)
|
||||
(map (lambda (d fn)
|
||||
|
|
|
|||
|
|
@ -41,9 +41,9 @@
|
|||
(let ([number (collected-info-number (part-collected-info d ht))])
|
||||
(unless (part-style? d 'hidden)
|
||||
(printf (string-append (make-string (add1 (number-depth number)) #\#) " "))
|
||||
(let ([s (format-number number '())])
|
||||
(let ([s (format-number number '() #t)])
|
||||
(unless (null? s)
|
||||
(printf "~a.~a"
|
||||
(printf "~a~a"
|
||||
(car s)
|
||||
(if (part-title-content d)
|
||||
" "
|
||||
|
|
|
|||
|
|
@ -37,9 +37,9 @@
|
|||
(define/override (render-part d ht)
|
||||
(let ([number (collected-info-number (part-collected-info d ht))])
|
||||
(unless (part-style? d 'hidden)
|
||||
(let ([s (format-number number '())])
|
||||
(let ([s (format-number number '() #t)])
|
||||
(unless (null? s)
|
||||
(printf "~a.~a"
|
||||
(printf "~a~a"
|
||||
(car s)
|
||||
(if (part-title-content d)
|
||||
" "
|
||||
|
|
|
|||
37
scribble-test/tests/scribble/docs/numberer.scrbl
Normal file
37
scribble-test/tests/scribble/docs/numberer.scrbl
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
#lang scribble/base
|
||||
@(require scribble/core)
|
||||
|
||||
@(define P (make-numberer (lambda (v parent-number)
|
||||
(values (list (format "[~a]" v) ; number in brackets
|
||||
"") ; no separator afterward
|
||||
(add1 v))) ; increment section number
|
||||
1)) @; count from 1
|
||||
@(define PL (make-numberer (lambda (v parent-number)
|
||||
(values (list (if (null? parent-number)
|
||||
(string v) ; top-level section is uppercase
|
||||
(string-downcase (string v))) ; nested is lowercase
|
||||
",") ; "," as separator
|
||||
(integer->char (add1 (char->integer v))))) ; increment letter
|
||||
#\A)) @; count from A
|
||||
|
||||
@(define (P-section . s) (section #:style (style #f (list P)) s))
|
||||
@(define (PL-section . s) (section #:style (style #f (list PL)) s))
|
||||
@(define (PL-subsection . s) (subsection #:style (style #f (list PL)) s))
|
||||
|
||||
@title{Two Tracks}
|
||||
|
||||
@P-section{Px}
|
||||
|
||||
@PL-section{Py}
|
||||
|
||||
@PL-section{PLx}
|
||||
|
||||
@P-section{Pz}
|
||||
@PL-subsection{PL-subx}
|
||||
@subsection{Normal}
|
||||
@PL-subsection{PL-suby}
|
||||
|
||||
@PL-section{PLy}
|
||||
|
||||
@PL-section{PLz}
|
||||
@subsection{Normal2}
|
||||
29
scribble-test/tests/scribble/docs/numberer.txt
Normal file
29
scribble-test/tests/scribble/docs/numberer.txt
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
Two Tracks
|
||||
|
||||
[1] Px
|
||||
|
||||
|
||||
A, Py
|
||||
|
||||
|
||||
B, PLx
|
||||
|
||||
|
||||
[2] Pz
|
||||
|
||||
[2]a, PL-subx
|
||||
|
||||
|
||||
[2]1. Normal
|
||||
|
||||
|
||||
[2]b, PL-suby
|
||||
|
||||
|
||||
C, PLy
|
||||
|
||||
|
||||
D, PLz
|
||||
|
||||
D,1. Normal2
|
||||
|
||||
Loading…
Reference in New Issue
Block a user