manual-style.rkt (9909B)
1 #lang racket/base 2 (require "../decode.rkt" 3 "../struct.rkt" 4 "../base.rkt" 5 (only-in "../basic.rkt" aux-elem itemize) 6 "../scheme.rkt" 7 (only-in "../core.rkt" content? make-style plain 8 make-nested-flow nested-flow? box-mode box-mode* 9 [element? core:element?]) 10 "manual-utils.rkt" 11 "on-demand.rkt" 12 "manual-sprop.rkt" 13 racket/list 14 racket/contract/base 15 racket/string) 16 17 (provide (rename-out [hyperlink link]) 18 (rename-out [other-doc other-manual]) 19 (rename-out [centered centerline]) 20 image 21 (rename-out [image image/plain]) 22 itemize 23 aux-elem 24 code-inset) 25 (provide/contract [filebox (((or/c core:element? string?)) () #:rest (listof pre-flow?) . ->* . block?)]) 26 27 (define styling-f/c 28 (() () #:rest (listof pre-content?) . ->* . element?)) 29 (define-syntax-rule (provide-styling id ...) 30 (provide/contract [id styling-f/c] ...)) 31 (provide-styling racketmodfont racketoutput 32 racketerror racketfont racketplainfont racketvalfont racketidfont racketvarfont 33 racketcommentfont racketparenfont racketoptionalfont racketkeywordfont racketmetafont 34 onscreen defterm filepath envvar Flag DFlag PFlag DPFlag math 35 procedure 36 indexed-file indexed-envvar idefterm pidefterm) 37 (provide 38 (contract-out [racketresultfont (->* () (#:decode? boolean?) #:rest (listof pre-content?) element?)])) 39 (define-syntax-rule (provide-scheme-styling [rid sid] ...) 40 (provide/contract [rename rid sid styling-f/c] ...)) 41 (provide-scheme-styling [racketmodfont schememodfont] 42 [racketoutput schemeoutput] 43 [racketerror schemeerror] 44 [racketfont schemefont] 45 [racketvalfont schemevalfont] 46 [racketresultfont schemeresultfont] 47 [racketidfont schemeidfont] 48 [racketvarfont schemevarfont] 49 [racketparenfont schemeparenfont] 50 [racketoptionalfont schemeoptionalfont] 51 [racketkeywordfont schemekeywordfont] 52 [racketmetafont schememetafont]) 53 54 (provide void-const 55 undefined-const) 56 (provide/contract 57 [PLaneT element?] 58 [hash-lang (-> element?)] 59 [etc element?] 60 [inset-flow (() () #:rest (listof pre-content?) . ->* . nested-flow?)] 61 [litchar (() () #:rest (listof string?) . ->* . element?)] 62 [t (() () #:rest (listof pre-content?) . ->* . paragraph?)] 63 [exec (() () #:rest (listof content?) . ->* . element?)] 64 [commandline (() () #:rest (listof content?) . ->* . paragraph?)] 65 [menuitem (string? string? . -> . element?)]) 66 67 (define PLaneT (make-element "planetName" '("PLaneT"))) 68 69 (define etc (make-element #f (list "etc" ._))) 70 71 (define (litchar . strs) 72 (let ([s (string-append* (map (lambda (s) (regexp-replace* "\n" s " ")) 73 strs))]) 74 (if (regexp-match? #rx"^ *$" s) 75 (make-element input-background-color (list (hspace (string-length s)))) 76 (let ([^spaces (car (regexp-match-positions #rx"^ *" s))] 77 [$spaces (car (regexp-match-positions #rx" *$" s))]) 78 (make-element 79 input-background-color 80 (list (hspace (cdr ^spaces)) 81 (make-element input-color 82 (list (substring s (cdr ^spaces) (car $spaces)))) 83 (hspace (- (cdr $spaces) (car $spaces))))))))) 84 85 (define (onscreen . str) 86 (make-element 'sf (decode-content str))) 87 (define (menuitem menu item) 88 (make-element 'sf (list menu "|" item))) 89 (define (defterm . str) 90 (make-element 'italic (decode-content str))) 91 (define (idefterm . str) 92 (let ([c (decode-content str)]) 93 (make-element 'italic c))) 94 (define (racketfont . str) 95 (apply tt str)) 96 (define (racketplainfont . str) 97 (make-element 'tt (decode-content str))) 98 (define (racketvalfont . str) 99 (make-element value-color (decode-content str))) 100 (define (racketresultfont #:decode? [decode? #t] . str) 101 (make-element result-color (if decode? (decode-content str) str))) 102 (define (racketidfont . str) 103 (make-element symbol-color (decode-content str))) 104 (define (racketvarfont . str) 105 (make-element variable-color (decode-content str))) 106 (define (racketparenfont . str) 107 (make-element paren-color (decode-content str))) 108 (define (racketoptionalfont . str) 109 (make-element opt-color (decode-content str))) 110 (define (racketmetafont . str) 111 (make-element meta-color (decode-content str))) 112 (define (racketcommentfont . str) 113 (make-element comment-color (decode-content str))) 114 (define (racketmodfont . str) 115 (make-element module-color (decode-content str))) 116 (define (racketkeywordfont . str) 117 (make-element keyword-color (decode-content str))) 118 (define (filepath . str) 119 (make-element 'tt (append (list "\"") (decode-content str) (list "\"")))) 120 (define (indexed-file . str) 121 (let* ([f (apply filepath str)] 122 [s (element->string f)]) 123 (index* (list (datum-intern-literal 124 (clean-up-index-string 125 (substring s 1 (sub1 (string-length s)))))) 126 (list f) 127 f))) 128 (define (exec . str) 129 (if (andmap string? str) 130 (make-element 'tt str) 131 (make-element #f (map (lambda (s) 132 (if (string? s) 133 (make-element 'tt (list s)) 134 s)) 135 str)))) 136 (define (Flag . str) 137 (make-element 'no-break 138 (list (make-element 'tt (cons "-" (decode-content str)))))) 139 (define (DFlag . str) 140 (make-element 'no-break 141 (list (make-element 'tt (cons "--" (decode-content str)))))) 142 (define (PFlag . str) 143 (make-element 'no-break 144 (list (make-element 'tt (cons "+" (decode-content str)))))) 145 (define (DPFlag . str) 146 (make-element 'no-break 147 (list (make-element 'tt (cons "++" (decode-content str)))))) 148 (define (envvar . str) 149 (make-element 'tt (decode-content str))) 150 (define (indexed-envvar . str) 151 (let* ([f (apply envvar str)] 152 [s (element->string f)]) 153 (index* (list s) (list f) f))) 154 (define (procedure . str) 155 (make-element result-color `("#<procedure:" ,@(decode-content str) ">"))) 156 157 (define (racketoutput . str) 158 (make-element output-color (decode-content str))) 159 (define (racketerror . str) 160 (make-element error-color (decode-content str))) 161 162 (define (t . str) 163 (decode-paragraph str)) 164 165 (define (inset-flow . c) 166 (make-blockquote "insetpara" (flow-paragraphs (decode-flow c)))) 167 168 (define code-inset-style 169 (make-style 'code-inset '(never-indents))) 170 (define (code-inset b) 171 (make-blockquote code-inset-style (list b))) 172 173 (define (commandline . s) 174 (make-paragraph (cons (hspace 2) (map (lambda (s) 175 (if (string? s) 176 (make-element 'tt (list s)) 177 s)) 178 s)))) 179 180 (define (pidefterm . s) 181 (let ([c (apply defterm s)]) 182 (index (string-append (content->string (element-content c)) "s") 183 c))) 184 185 (define (hash-lang) 186 (make-link-element 187 module-link-color 188 (list (racketmodfont "#lang")) 189 `(part ,(doc-prefix '(lib "scribblings/guide/guide.scrbl") "hash-lang")))) 190 191 (define (make-v+u-link p) 192 (make-link-element 193 module-link-color 194 p 195 `(part ,(doc-prefix '(lib "scribblings/guide/guide.scrbl") "void+undefined")))) 196 197 (define-on-demand void-const 198 (make-v+u-link 199 (nonbreaking (racketresultfont "#<void>")))) 200 (define-on-demand undefined-const 201 (make-v+u-link 202 (nonbreaking (racketresultfont "#<undefined>")))) 203 204 (define (link url 205 #:underline? [underline? #t] 206 #:style [style (if underline? #f "plainlink")] 207 . str) 208 (apply hyperlink url #:style (if style (make-style style null) plain) str)) 209 210 (define (math . s) 211 (let ([c (decode-content s)]) 212 (make-element 213 #f 214 (append-map 215 (lambda (i) 216 (let loop ([i i]) 217 (cond 218 [(string? i) 219 (cond 220 [(regexp-match #px"^(.*)_([a-zA-Z0-9]+)(.*)$" i) 221 => (lambda (m) 222 (append (loop (cadr m)) 223 (list (make-element 'subscript 224 (loop (caddr m)))) 225 (loop (cadddr m))))] 226 [(regexp-match #px"^(.*)\\^([a-zA-Z0-9]+)(.*)$" i) 227 => (lambda (m) 228 (append (loop (cadr m)) 229 (list (make-element 'superscript 230 (loop (caddr m)))) 231 (loop (cadddr m))))] 232 [(regexp-match #px"^(.*)([()0-9{}\\[\\]\u03C0])(.*)$" i) 233 => (lambda (m) 234 (append (loop (cadr m)) 235 (list (caddr m)) 236 (loop (cadddr m))))] 237 [else 238 (list (make-element 'italic (list i)))])] 239 [(eq? i 'rsquo) (list 'prime)] 240 [else (list i)]))) 241 c)))) 242 243 (define (filebox filename . inside) 244 (make-nested-flow 245 (make-style "Rfilebox" (list* 'multicommand 246 (box-mode "RfileboxBoxT" "RfileboxBoxC" "RfileboxBoxB") 247 scheme-properties)) 248 (list 249 (make-styled-paragraph 250 (list (make-element 251 (make-style "Rfilename" scheme-properties) 252 (if (string? filename) 253 (filepath filename) 254 filename))) 255 (make-style "Rfiletitle" (cons (box-mode* "RfiletitleBox") scheme-properties))) 256 (make-nested-flow 257 (make-style "Rfilecontent" (cons (box-mode* "RfilecontentBox") scheme-properties)) 258 (decode-flow inside))))) 259 260