Cleaned up the definition of @chunk and @CHUNK. Fixed issues with subscript numbers on chunks, links, and conflicting tags. Now it's possible to re-print a chunk several times without problem.
This commit is contained in:
Georges Dupéron
parent
148ec8da08
commit
fe2b582def
|
|
@ -221,10 +221,7 @@
|
|||
(define-syntax-rule
|
||||
(unless-preexpanding . b)
|
||||
(begin . b))
|
||||
(require (only-in racket/require
|
||||
subtract-in)
|
||||
(subtract-in scribble/manual
|
||||
scribble-enhanced)
|
||||
(require scribble-enhanced/with-manual
|
||||
scribble-enhanced
|
||||
hyper-literate))))
|
||||
(begn body0 . body))
|
||||
|
|
|
|||
133
private/lp.rkt
133
private/lp.rkt
|
|
@ -18,20 +18,26 @@
|
|||
chunk-numbers id
|
||||
(+ 1 (free-identifier-mapping-get chunk-numbers id))))
|
||||
(define (init-chunk-number id)
|
||||
(free-identifier-mapping-put! chunk-numbers id 2)))
|
||||
(free-identifier-mapping-put! chunk-numbers id 2))
|
||||
|
||||
(define repeat-chunk-numbers (make-free-identifier-mapping))
|
||||
(define (get+increment-repeat-chunk-number! id)
|
||||
(let ([current (free-identifier-mapping-get repeat-chunk-numbers
|
||||
id
|
||||
(lambda () 1))])
|
||||
(free-identifier-mapping-put! repeat-chunk-numbers id (add1 current))
|
||||
;; note: due to multiple expansions, this does not increase exactly one at
|
||||
;; a time but instead it can skip numbers. Since this is not visible by
|
||||
;; the user, and just used as a token in the URL, it's okay as long as
|
||||
;; compiling the same file twice gives the same numbers (which is
|
||||
;; hopefully the case but hasn't been tested).
|
||||
current)))
|
||||
|
||||
(require (for-syntax "no-auto-require.rkt"))
|
||||
(define-for-syntax ((make-chunk racketblock unsyntax?) stx)
|
||||
(syntax-parse stx
|
||||
[(_ (~optional (~seq #:save-as save-as)) name expr ...)
|
||||
(define-for-syntax (make-chunk-code unsyntax?)
|
||||
(syntax-parser
|
||||
;; no need for more error checking, using chunk for the code will do that
|
||||
(identifier? #'name)
|
||||
(let* ([n (get-chunk-number (syntax-local-introduce #'name))]
|
||||
[str (symbol->string (syntax-e #'name))]
|
||||
[tag (format "chunk:~a:~a" str (or n 1))])
|
||||
|
||||
(when n
|
||||
(inc-chunk-number (syntax-local-introduce #'name)))
|
||||
[(_ name:id expr ...)
|
||||
|
||||
;; Lift the code so that it is caught by `extract-chunks` in common.rkt
|
||||
;(syntax-local-lift-expression #'(quote-syntax (a-chunk name expr ...)))
|
||||
|
|
@ -54,21 +60,19 @@
|
|||
(syntax-local-introduce #'here)))
|
||||
(define intr (make-syntax-delta-introducer b a))
|
||||
(syntax-local-lift-expression
|
||||
(intr #`(quote-syntax (a-chunk ((... ...) name)
|
||||
(intr #'(quote-syntax (a-chunk ((... ...) name)
|
||||
((... ...) expr) ...))
|
||||
'flip))
|
||||
#'(void))
|
||||
(macro-to-expand-unsyntax))
|
||||
;; Default (old) behaviour, which does not support escaping via #,
|
||||
;; Default (old) behaviour, does not support escaping via #,
|
||||
(begin (syntax-local-lift-expression
|
||||
#'(quote-syntax (a-chunk name expr ...)))
|
||||
#f)))
|
||||
|
||||
|
||||
(with-syntax
|
||||
;; Extract require forms
|
||||
(with-syntax ([tag tag]
|
||||
[str str]
|
||||
[((for-label-mod ...) ...)
|
||||
([((for-label-mod ...) ...)
|
||||
(if (unbox no-auto-require?)
|
||||
#'()
|
||||
(map (lambda (expr)
|
||||
|
|
@ -94,43 +98,96 @@
|
|||
[x
|
||||
(cons #'x (loop (cdr mods)))])]))]
|
||||
[else null]))
|
||||
(syntax->list #'(expr ...))))]
|
||||
|
||||
[(rest ...) (if n
|
||||
#`((subscript #,(format "~a" n)))
|
||||
#`())])
|
||||
(define/with-syntax pre-content
|
||||
#`(make-splice
|
||||
(list (make-toc-element
|
||||
#f
|
||||
(list (elemtag '(prefixable tag)
|
||||
(bold (italic (racket name)) " ::=")))
|
||||
(list (smaller (elemref '(prefixable tag) #:underline? #f
|
||||
str
|
||||
rest ...))))
|
||||
(#,racketblock expr ...))))
|
||||
(syntax->list #'(expr ...))))])
|
||||
#`(begin
|
||||
#,@(if expand-unsyntax expand-unsyntax #'())
|
||||
#,@(if (null? (syntax-e #'(for-label-mod ... ...)))
|
||||
#'()
|
||||
#'((require (for-label for-label-mod ... ...))))
|
||||
#'((require (for-label for-label-mod ... ...))))))]))
|
||||
|
||||
(define-for-syntax ((make-chunk-display racketblock) stx)
|
||||
(syntax-parse stx
|
||||
;; no need for more error checking, using chunk for the code will do that
|
||||
[(_ original-name:id name:id stxn:number expr ...)
|
||||
(define n (syntax-e #'stxn))
|
||||
(define n-repeat (get+increment-repeat-chunk-number!
|
||||
(syntax-local-introduce
|
||||
(format-id #'name "~a:~a" #'name n))))
|
||||
(define str (string-append (symbol->string (syntax-e #'name))))
|
||||
(define/with-syntax tag (format "chunk:~a:~a:~a" str n n-repeat))
|
||||
(define/with-syntax (rest ...)
|
||||
;; if the would-be-next number for this chunk name is "2", then there is
|
||||
;; only one chunk, whose number is "1". Otherwise, if the number is 3 or
|
||||
;; more, it means that the chunk with number "2" exists, so we should
|
||||
;; display the subscript numbers.
|
||||
(if (let ([c (get-chunk-number #'original-name)])
|
||||
(and c (> c 2)))
|
||||
#`((subscript #,(format "~a" n)))
|
||||
#'()))
|
||||
#`(make-splice
|
||||
(list (make-toc-element
|
||||
#f
|
||||
(list (elemtag '(prefixable tag)
|
||||
(bold (italic (elemref '(prefixable tag)
|
||||
#:underline? #f
|
||||
#,str rest ...))
|
||||
" ::=")))
|
||||
(list (smaller (elemref '(prefixable tag) #:underline? #f
|
||||
#,str
|
||||
rest ...))))
|
||||
(#,racketblock expr ...)))]))
|
||||
|
||||
(define-for-syntax (make-chunk chunk-code chunk-display)
|
||||
(syntax-parser
|
||||
;; no need for more error checking, using chunk for the code will do that
|
||||
[(_ (~optional (~seq #:save-as save-as:id)) name:id expr ...)
|
||||
(define n (get-chunk-number (syntax-local-introduce #'name)))
|
||||
(define str (symbol->string (syntax-e #'name)))
|
||||
|
||||
(when n
|
||||
(inc-chunk-number (syntax-local-introduce #'name)))
|
||||
|
||||
(define/with-syntax stx-n (or n 1))
|
||||
(define/with-syntax stx-chunk-code chunk-code)
|
||||
(define/with-syntax stx-chunk-display chunk-display)
|
||||
|
||||
#`(begin
|
||||
(stx-chunk-code name expr ...)
|
||||
#,@(if n
|
||||
#'()
|
||||
#'((define-syntax name (make-element-id-transformer
|
||||
(lambda (stx) #'(chunkref name))))
|
||||
(begin-for-syntax (init-chunk-number #'name))))
|
||||
#,(if (attribute save-as)
|
||||
#'(define-syntax (save-as s) (quote-syntax pre-content))
|
||||
#'pre-content))))]))
|
||||
#'(define-syntax (save-as s)
|
||||
(syntax-case s ()
|
||||
[(_)
|
||||
#`(save-as #,(syntax-local-introduce
|
||||
(quote-syntax name)))]
|
||||
[(_ newname)
|
||||
#`(stx-chunk-display
|
||||
#,(syntax-local-introduce
|
||||
(quote-syntax name))
|
||||
newname
|
||||
stx-n
|
||||
#,@(syntax-local-introduce
|
||||
(quote-syntax (expr ...))))]))
|
||||
;; The (list) here is important, to avoid the code being executed
|
||||
;; multiple times in weird ways, when pre-expanding.
|
||||
#`(list (stx-chunk-display name name stx-n expr ...))))]))
|
||||
|
||||
(define-syntax chunk (make-chunk #'racketblock #t))
|
||||
(define-syntax CHUNK (make-chunk #'RACKETBLOCK #f))
|
||||
(define-syntax chunk-code (make-chunk-code #t))
|
||||
(define-syntax CHUNK-code (make-chunk-code #f))
|
||||
(define-syntax chunk-display (make-chunk-display #'racketblock))
|
||||
(define-syntax CHUNK-display (make-chunk-display #'RACKETBLOCK))
|
||||
(define-syntax chunk (make-chunk #'chunk-code #'chunk-display))
|
||||
(define-syntax CHUNK (make-chunk #'CHUNK-code #'CHUNK-display))
|
||||
|
||||
(define-syntax (chunkref stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id)
|
||||
(identifier? #'id)
|
||||
(with-syntax ([tag (format "chunk:~a:1" (syntax-e #'id))]
|
||||
(with-syntax ([tag (format "chunk:~a:1:1" (syntax-e #'id))]
|
||||
[str (format "~a" (syntax-e #'id))])
|
||||
#'(elemref '(prefixable tag) #:underline? #f str))]))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user