doc.rkt (6496B)
1 #lang racket 2 3 ;; Math 4 (require slideshow/pict) 5 (provide (all-from-out slideshow/pict)) 6 (require "math.rkt") 7 (provide (all-from-out "math.rkt")) 8 ; @setup-math is returned in @doc-lib-setup. 9 10 11 (require scriblib/render-cond) 12 13 ;(require "(submod low.rkt untyped)") 14 ;(#lang reader "scribble-custom/lp2.rkt" #:lang typed/racket) 15 16 ;; http://lists.racket-lang.org/users/archive/2015-January/065752.html 17 ;; http://bugs.racket-lang.org/query/?cmd=view%20audit-trail&pr=14068 18 ;; &database=default 19 ;(require (for-label (only-meta-in 0 typed/racket))) 20 ;(provide (for-label (all-from-out typed/racket))) 21 22 ;; ==== remote images ==== 23 (provide remote-image) 24 (require (only-in scribble/core make-style) 25 (only-in scribble/html-properties alt-tag attributes)) 26 (define (remote-image src alt) 27 (cond-element 28 [html (elem 29 #:style 30 (make-style #f 31 (list (alt-tag "img") 32 (attributes 33 `((src . ,src) 34 (alt . ,alt))))))] 35 [else (elem)])) 36 37 ;; ==== hybrid footnotes/margin-note ==== 38 (provide note) 39 (require (only-in scriblib/footnote [note footnote]) 40 (only-in scribble/base margin-note) 41 (only-in scribble/core nested-flow style)) 42 43 (define (note . args) 44 (cond-element 45 [html (element (style "refpara" '()) 46 (list (element (style "refcolumn" '()) 47 (list (element (style "refcontent" '()) 48 (list args))))))] 49 [else (apply footnote args)])) 50 51 ;; ==== ==== 52 53 (require (for-syntax mzlib/etc)) 54 (define-syntax (doc-lib-setup stx) 55 ;(display (build-path (this-expression-source-directory) 56 ; (this-expression-file-name))) 57 #'setup-math) ;; NOTE: setup-math must be returned, not just called! 58 59 (provide doc-lib-setup) 60 61 ;(require (only-in scribble/manual code)) 62 ;(define-syntax-rule (tc . args) 63 ; (code #:lang "typed/racket" . args)) 64 ;(provide tc) 65 66 ;(require (only-in scribble/private/lp chunk CHUNK)) 67 ;(provide chunk CHUNK) 68 69 70 71 72 73 74 ;; Copied from the file: 75 ;; /usr/local/racket-6.2.900.6/share/pkgs/scribble-lib/scribble/private/lp.rkt 76 77 (require (for-syntax racket/base syntax/boundmap) 78 scribble/scheme scribble/decode scribble/manual 79 (except-in scribble/struct table)) 80 81 (begin-for-syntax 82 ;; maps chunk identifiers to a counter, so we can distinguish multiple uses 83 ;; of the same name 84 (define chunk-numbers (make-free-identifier-mapping)) 85 (define (get-chunk-number id) 86 (free-identifier-mapping-get chunk-numbers id (lambda () #f))) 87 (define (inc-chunk-number id) 88 (free-identifier-mapping-put! chunk-numbers id 89 (+ 1 90 (free-identifier-mapping-get chunk-numbers 91 id)))) 92 (define (init-chunk-number id) 93 (free-identifier-mapping-put! chunk-numbers id 2))) 94 95 (define-syntax-rule (make-chunk chunk-id racketblock) 96 (define-syntax (chunk-id stx) 97 (syntax-case stx () 98 [(_ name expr (... ...)) 99 ;; no need for more error checking, using chunk for the code will do that 100 (identifier? #'name) 101 (let* ([n (get-chunk-number (syntax-local-introduce #'name))] 102 [str (symbol->string (syntax-e #'name))] 103 [tag (format "~a:~a" str (or n 1))]) 104 105 (when n 106 (inc-chunk-number (syntax-local-introduce #'name))) 107 108 (syntax-local-lift-expression #'(quote-syntax (a-chunk name 109 expr 110 (... ...)))) 111 112 (with-syntax ([tag tag] 113 [str str] 114 [((for-label-mod (... ...)) (... ...)) 115 (map (lambda (expr) 116 (syntax-case expr (require) 117 [(require mod (... ...)) 118 (let loop 119 ([mods (syntax->list #'(mod (... ...)))]) 120 (cond 121 [(null? mods) null] 122 [else 123 (syntax-case (car mods) (for-syntax) 124 [(for-syntax x (... ...)) 125 (append (loop (syntax->list 126 #'(x (... ...)))) 127 (loop (cdr mods)))] 128 [x 129 (cons #'x (loop (cdr mods)))])]))] 130 [else null])) 131 (syntax->list #'(expr (... ...))))] 132 133 [(rest (... ...)) (if n 134 #`((subscript #,(format "~a" n))) 135 #`())]) 136 #`(begin 137 #,@(if (null? (syntax-e #'(for-label-mod (... ...) (... ...)))) 138 #'() 139 #'((require (for-label for-label-mod (... ...) (... ...))))) 140 #,@(if n 141 #'() 142 #'((define-syntax name (make-element-id-transformer 143 (lambda (stx) #'(chunkref name)))) 144 (begin-for-syntax (init-chunk-number #'name)))) 145 ;(make-splice 146 ;(list (make-toc-element 147 ;#f 148 ;(list (elemtag '(chunk tag) 149 ; (bold (italic (racket name)) " ::="))) 150 ;(list (smaller (elemref '(chunk tag) #:underline? #f 151 ; str 152 ; rest (... ...))))) 153 (racket expr (... ...)))))]))) ;)) 154 155 (make-chunk chunk2 racketblock) 156 (make-chunk CHUNK2 RACKETBLOCK) 157 158 (define-syntax (chunkref stx) 159 (syntax-case stx () 160 [(_ id) 161 (identifier? #'id) 162 (with-syntax ([tag (format "~a:1" (syntax-e #'id))] 163 [str (format "~a" (syntax-e #'id))]) 164 #'(elemref '(chunk tag) #:underline? #f str))])) 165 166 (provide chunk2 CHUNK2) 167 168 (provide tc TC) 169 (define-syntax-rule (tc . rest) (chunk2 name . rest)) 170 (define-syntax-rule (TC . rest) (CHUNK2 name . rest))