suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Added auto-parentheses for repeated chunks, and finally (hopefully) fixed the link numbering problems (last bug was that the save-as chunks had numbers total+i, but the references within the code were made to the number 1 which did not exist).

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-20 07:12:44 +02:00
parent fe2b582def
commit 6f5e7d92ff
2 changed files with 68 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
private/common.rkt
View File

@ -218,8 +218,7 @@
b) b)
(define-syntax-rule (when-preexpanding . b) (define-syntax-rule (when-preexpanding . b)
(begin)) (begin))
(define-syntax-rule (define-syntax-rule (unless-preexpanding . b)
(unless-preexpanding . b)
(begin . b)) (begin . b))
(require scribble-enhanced/with-manual (require scribble-enhanced/with-manual
scribble-enhanced scribble-enhanced

100
private/lp.rkt
View File

@ -19,18 +19,23 @@
(+ 1 (free-identifier-mapping-get chunk-numbers id)))) (+ 1 (free-identifier-mapping-get chunk-numbers id))))
(define (init-chunk-number 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 repeat-chunk-numbers (make-free-identifier-mapping))
(define (init-repeat-chunk-number id)
(free-identifier-mapping-put! repeat-chunk-numbers id 1))
(define (get-repeat-chunk-number id)
(free-identifier-mapping-get repeat-chunk-numbers
id
(lambda () 1)))
(define (get+increment-repeat-chunk-number! id) (define (get+increment-repeat-chunk-number! id)
(let ([current (free-identifier-mapping-get repeat-chunk-numbers (let ([current (free-identifier-mapping-get repeat-chunk-numbers
id id
(lambda () 1))]) (lambda () 1))])
(free-identifier-mapping-put! repeat-chunk-numbers id (add1 current))
;; note: due to multiple expansions, this does not increase exactly one at ;; 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 ;; 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 ;; 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 ;; compiling the same file twice gives the same numbers (which is
;; hopefully the case but hasn't been tested). ;; hopefully the case but hasn't been tested).
(free-identifier-mapping-put! repeat-chunk-numbers id (add1 current))
current))) current)))
(require (for-syntax "no-auto-require.rkt")) (require (for-syntax "no-auto-require.rkt"))
@ -104,15 +109,16 @@
#,@(if (null? (syntax-e #'(for-label-mod ... ...))) #,@(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) (define-for-syntax ((make-chunk-display racketblock) stx)
(syntax-parse stx (syntax-parse stx
;; no need for more error checking, using chunk for the code will do that ;; no need for more error checking, using chunk for the code will do that
[(_ original-name:id name:id stxn:number expr ...) [(_ original-name:id name:id stxn:number expr ...)
(define n (syntax-e #'stxn)) (define n (syntax-e #'stxn))
(define original-name:n (syntax-local-introduce
(format-id #'original-name "~a:~a" #'original-name n)))
(define n-repeat (get+increment-repeat-chunk-number! (define n-repeat (get+increment-repeat-chunk-number!
(syntax-local-introduce original-name:n))
(format-id #'name "~a:~a" #'name n))))
(define str (string-append (symbol->string (syntax-e #'name)))) (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 tag (format "chunk:~a:~a:~a" str n n-repeat))
(define/with-syntax (rest ...) (define/with-syntax (rest ...)
@ -124,25 +130,33 @@
(and c (> c 2))) (and c (> c 2)))
#`((subscript #,(format "~a" n))) #`((subscript #,(format "~a" n)))
#'())) #'()))
#`(make-splice ;; The (list) here could be important, to avoid the code being
(list (make-toc-element ;; executed multiple times in weird ways, when pre-expanding.
#f #`(list
(list (elemtag '(prefixable tag) (make-splice
(bold (italic (elemref '(prefixable tag) (list (make-toc-element
#:underline? #f #f
#,str rest ...)) (list (elemtag '(prefixable tag)
" ::="))) (bold (italic (elemref '(prefixable tag)
(list (smaller (elemref '(prefixable tag) #:underline? #f #:underline? #f
#,str #,str rest ...))
rest ...)))) " ::=")))
(#,racketblock expr ...)))])) (list (smaller (elemref '(prefixable tag) #:underline? #f
#,str
rest ...))))
(#,racketblock expr ...))))]))
(define-for-syntax (make-chunk chunk-code chunk-display) (define-for-syntax (make-chunk chunk-code chunk-display)
(syntax-parser (syntax-parser
;; no need for more error checking, using chunk for the code will do that ;; no need for more error checking, using chunk for the code will do that
[(_ (~optional (~seq #:save-as save-as:id)) name:id expr ...) [(_ (~optional (~seq #:save-as save-as:id)) name:id expr ...)
(define n (get-chunk-number (syntax-local-introduce #'name))) (define n (get-chunk-number (syntax-local-introduce #'name)))
(define str (symbol->string (syntax-e #'name))) (define/with-syntax name:n (format-id #'name "~a:~a" #'name (or n 1)))
(define/with-syntax stripped-name
(regexp-replace #px"^<(.*)>$"
(symbol->string (syntax-e #'name))
"\\1"))
(when n (when n
(inc-chunk-number (syntax-local-introduce #'name))) (inc-chunk-number (syntax-local-introduce #'name)))
@ -159,21 +173,41 @@
(lambda (stx) #'(chunkref name)))) (lambda (stx) #'(chunkref name))))
(begin-for-syntax (init-chunk-number #'name)))) (begin-for-syntax (init-chunk-number #'name))))
#,(if (attribute save-as) #,(if (attribute save-as)
#'(define-syntax (save-as s) #`(begin
(syntax-case s () #,#'(define-syntax (do-for-syntax _)
[(_) (init-repeat-chunk-number (quote-syntax name:n))
#`(save-as #,(syntax-local-introduce #'(void))
(quote-syntax name)))] (do-for-syntax)
[(_ newname) (define-syntax (save-as s)
#`(stx-chunk-display (syntax-case s ()
#,(syntax-local-introduce [(_)
(quote-syntax name)) (let* ([local-name (syntax-local-introduce
newname (quote-syntax name))]
stx-n [local-name:n (syntax-local-introduce
#,@(syntax-local-introduce (quote-syntax name:n))]
(quote-syntax (expr ...))))])) [n-repeat (get-repeat-chunk-number
;; The (list) here is important, to avoid the code being executed local-name:n)])
;; multiple times in weird ways, when pre-expanding. (with-syntax
([name-maybe-paren (if (> n-repeat 1)
(format-id local-name
"(~a)"
stripped-name)
local-name)])
#'(save-as name-maybe-paren)))]
[(_ newname)
(with-syntax ([local-name
(syntax-local-introduce
(quote-syntax name))]
[(local-expr (... ...))
(syntax-local-introduce
(quote-syntax (expr ...)))])
#`(stx-chunk-display
local-name
newname
stx-n
local-expr (... ...)))])))
;; The (list) here could be important, to avoid the code being
;; executed multiple times in weird ways, when pre-expanding.
#`(list (stx-chunk-display name name stx-n expr ...))))])) #`(list (stx-chunk-display name name stx-n expr ...))))]))
(define-syntax chunk-code (make-chunk-code #t)) (define-syntax chunk-code (make-chunk-code #t))