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

Add CHUNK

Browse Source 
original commit: 05128592353ba81d378afb55ebb9724cfd8aecc4
This commit is contained in:
Jay McCarthy 2013-07-22 09:45:41 -06:00
parent 4448ccae6b
commit 8a8a54fec9
3 changed files with 53 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/scribble-pkgs/scribble-lib/scribble/lp-include.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require scheme/include (for-syntax scheme/base) (require scheme/include (for-syntax scheme/base)
(only-in scribble/private/lp chunk) (only-in scribble/private/lp chunk CHUNK)
scribble/manual) scribble/manual)
(provide lp-include) (provide lp-include)

2
pkgs/scribble-pkgs/scribble-lib/scribble/lp.rkt
View File

@ -1,3 +1,3 @@
#lang racket/base #lang racket/base
(require scribble/private/lp) (require scribble/private/lp)
(provide chunk) (provide chunk CHUNK)

32
pkgs/scribble-pkgs/scribble-lib/scribble/private/lp.rkt
View File

@ -14,9 +14,10 @@
(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-syntax (chunk stx) (define-syntax-rule (define-chunk chunk-id racketblock)
(define-syntax (chunk-id stx)
(syntax-case stx () (syntax-case stx ()
[(_ name expr ...) [(_ name expr (... ...))
;; 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
(identifier? #'name) (identifier? #'name)
(let* ([n (get-chunk-number (syntax-local-introduce #'name))] (let* ([n (get-chunk-number (syntax-local-introduce #'name))]
@ -26,32 +27,32 @@
(when n (when n
(inc-chunk-number (syntax-local-introduce #'name))) (inc-chunk-number (syntax-local-introduce #'name)))
(syntax-local-lift-expression #'(quote-syntax (a-chunk name expr ...))) (syntax-local-lift-expression #'(quote-syntax (a-chunk name expr (... ...))))
(with-syntax ([tag tag] (with-syntax ([tag tag]
[str str] [str str]
[((for-label-mod ...) ...) [((for-label-mod (... ...)) (... ...))
(map (lambda (expr) (map (lambda (expr)
(syntax-case expr (require) (syntax-case expr (require)
[(require mod ...) [(require mod (... ...))
(let loop ([mods (syntax->list #'(mod ...))]) (let loop ([mods (syntax->list #'(mod (... ...)))])
(cond (cond
[(null? mods) null] [(null? mods) null]
[else [else
(syntax-case (car mods) (for-syntax) (syntax-case (car mods) (for-syntax)
[(for-syntax x ...) [(for-syntax x (... ...))
(append (loop (syntax->list #'(x ...))) (append (loop (syntax->list #'(x (... ...))))
(loop (cdr mods)))] (loop (cdr mods)))]
[x [x
(cons #'x (loop (cdr mods)))])]))] (cons #'x (loop (cdr mods)))])]))]
[else null])) [else null]))
(syntax->list #'(expr ...)))] (syntax->list #'(expr (... ...))))]
[(rest ...) (if n [(rest (... ...)) (if n
#`((subscript #,(format "~a" n))) #`((subscript #,(format "~a" n)))
#`())]) #`())])
#`(begin #`(begin
(require (for-label for-label-mod ... ...)) (require (for-label for-label-mod (... ...) (... ...)))
#,@(if n #,@(if n
#'() #'()
#'((define-syntax name (make-element-id-transformer #'((define-syntax name (make-element-id-transformer
@ -64,8 +65,11 @@
(bold (italic (racket name)) " ::="))) (bold (italic (racket name)) " ::=")))
(list (smaller (elemref '(chunk tag) #:underline? #f (list (smaller (elemref '(chunk tag) #:underline? #f
str str
rest ...)))) rest (... ...)))))
(racketblock expr ...))))))])) (racketblock expr (... ...)))))))])))
(define-chunk chunk racketblock)
(define-chunk CHUNK RACKETBLOCK)
(define-syntax (chunkref stx) (define-syntax (chunkref stx)
(syntax-case stx () (syntax-case stx ()
@ -78,4 +82,4 @@
(provide (all-from-out scheme/base (provide (all-from-out scheme/base
scribble/manual) scribble/manual)
chunk) chunk CHUNK)