diff --git a/scribble-doc/scribblings/scribble/core.scrbl b/scribble-doc/scribblings/scribble/core.scrbl index c8354a08..686b4222 100644 --- a/scribble-doc/scribblings/scribble/core.scrbl +++ b/scribble-doc/scribblings/scribble/core.scrbl @@ -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] diff --git a/scribble-lib/scribble/base-render.rkt b/scribble-lib/scribble/base-render.rkt index 6c2f5440..42df4384 100644 --- a/scribble-lib/scribble/base-render.rkt +++ b/scribble-lib/scribble/base-render.rkt @@ -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)) - ds)) + (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 sub-grouper? - (number->roman pos) - pos)) + (if numberer + numberer-str + (if sub-grouper? + (number->roman 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) diff --git a/scribble-lib/scribble/core.rkt b/scribble-lib/scribble/core.rkt index 196c99b0..5e11043f 100644 --- a/scribble-lib/scribble/core.rkt +++ b/scribble-lib/scribble/core.rkt @@ -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])] diff --git a/scribble-lib/scribble/html-render.rkt b/scribble-lib/scribble/html-render.rkt index 778ecf60..15b454eb 100644 --- a/scribble-lib/scribble/html-render.rkt +++ b/scribble-lib/scribble/html-render.rkt @@ -341,12 +341,12 @@ ;; ---------------------------------------- (define/override (start-collect ds fns ci) - (map (lambda (d fn) - (parameterize ([current-output-file fn] - [current-top-part d]) - (collect-part d #f ci null 1))) - ds - fns)) + (for-each (lambda (d fn) + (parameterize ([current-output-file fn] + [current-top-part d]) + (collect-part d #f ci null 1 #hash()))) + ds + fns)) (define/public (part-whole-page? p ri) (let ([dest (resolve-get p ri (car (part-tags/nonempty p)))]) @@ -1906,14 +1906,14 @@ (define/override (start-collect ds fns ci) (parameterize ([current-part-files (make-hash)]) - (map (lambda (d fn) - (parameterize ([collecting-sub - (if (part-style? d 'non-toc) - 1 - 0)]) - (super start-collect (list d) (list fn) ci))) - ds - fns))) + (for-each (lambda (d fn) + (parameterize ([collecting-sub + (if (part-style? d 'non-toc) + 1 + 0)]) + (super start-collect (list d) (list fn) ci))) + ds + fns))) (define/private (check-duplicate-filename orig-s) (let ([s (string-downcase (path->string orig-s))]) @@ -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) diff --git a/scribble-lib/scribble/markdown-render.rkt b/scribble-lib/scribble/markdown-render.rkt index 13478d41..58847f74 100644 --- a/scribble-lib/scribble/markdown-render.rkt +++ b/scribble-lib/scribble/markdown-render.rkt @@ -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) " " diff --git a/scribble-lib/scribble/text-render.rkt b/scribble-lib/scribble/text-render.rkt index 22f3718c..45686e6a 100644 --- a/scribble-lib/scribble/text-render.rkt +++ b/scribble-lib/scribble/text-render.rkt @@ -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) " " diff --git a/scribble-test/tests/scribble/docs/numberer.scrbl b/scribble-test/tests/scribble/docs/numberer.scrbl new file mode 100644 index 00000000..758aa9eb --- /dev/null +++ b/scribble-test/tests/scribble/docs/numberer.scrbl @@ -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} diff --git a/scribble-test/tests/scribble/docs/numberer.txt b/scribble-test/tests/scribble/docs/numberer.txt new file mode 100644 index 00000000..eeb43267 --- /dev/null +++ b/scribble-test/tests/scribble/docs/numberer.txt @@ -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 +