commit dfc950f2a8800fc4a906b3cce1a84aad9cbf5a3e Author: Suzanne Soy <no-reply@suzanne.soy> Date: Thu, 12 Feb 2026 20:15:31 +0000 Discarded history for now, this commit is the same as d4fe76d1899b540e2806520a3acbf4afdf5abb88 but without the history. Will restore history shortly once hosting issues are sorted. Send me an e-mail at racket.suzanne.soy at my domain if you need the history urgently. Diffstat:
| A | .gitignore | | | 7 | +++++++ |
| A | .travis.yml | | | 66 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | LICENSE.txt | | | 34 | ++++++++++++++++++++++++++++++++++ |
| A | README.md | | | 47 | +++++++++++++++++++++++++++++++++++++++++++++++ |
| A | doc.rkt | | | 170 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | forkmeongithub.rkt | | | 85 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | info.rkt | | | 26 | ++++++++++++++++++++++++++ |
| A | lgpl-3.0--license.txt | | | 165 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | main.rkt | | | 5 | +++++ |
| A | manual-form.rkt | | | 660 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | manual-scheme.rkt | | | 291 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | math.rkt | | | 38 | ++++++++++++++++++++++++++++++++++++++ |
| A | racket.rkt | | | 1448 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | scribblings/scribble-enhanced-example.lp2.rkt | | | 64 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | scribblings/scribble-enhanced-template.lp2.rkt | | | 112 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | scribblings/scribble-enhanced.scrbl | | | 219 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | unicode-chars.sty.rkt | | | 411 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | with-manual.rkt | | | 8 | ++++++++ |
18 files changed, 3856 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore @@ -0,0 +1,6 @@ +*~ +\#* +.\#* +.DS_Store +compiled/ +/doc/ +\ No newline at end of file diff --git a/.travis.yml b/.travis.yml @@ -0,0 +1,66 @@ +language: c + +# Based from: https://github.com/greghendershott/travis-racket + +# Optional: Remove to use Travis CI's older infrastructure. +sudo: false + +env: + global: + # Supply a global RACKET_DIR environment variable. This is where + # Racket will be installed. A good idea is to use ~/racket because + # that doesn't require sudo to install and is therefore compatible + # with Travis CI's newer container infrastructure. + - RACKET_DIR=~/racket + matrix: + # Supply at least one RACKET_VERSION environment variable. This is + # used by the install-racket.sh script (run at before_install, + # below) to select the version of Racket to download and install. + # + # Supply more than one RACKET_VERSION (as in the example below) to + # create a Travis-CI build matrix to test against multiple Racket + # versions. + #- RACKET_VERSION=6.0 + #- RACKET_VERSION=6.1 + #- RACKET_VERSION=6.1.1 + #- RACKET_VERSION=6.2 + - RACKET_VERSION=6.3 + - RACKET_VERSION=6.4 + - RACKET_VERSION=6.5 + - RACKET_VERSION=6.6 + - RACKET_VERSION=6.7 + - RACKET_VERSION=6.8 + - RACKET_VERSION=6.9 + - RACKET_VERSION=6.10 + - RACKET_VERSION=6.10.1 + - RACKET_VERSION=6.11 + - RACKET_VERSION=6.12 + - RACKET_VERSION=7.0 + - RACKET_VERSION=7.1 + - RACKET_VERSION=7.2 + - RACKET_VERSION=HEAD + +matrix: + allow_failures: + fast_finish: true + +before_install: +- git clone https://github.com/greghendershott/travis-racket.git +- cat travis-racket/install-racket.sh | bash # pipe to bash not sh! +- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us + +install: + - raco pkg install --deps search-auto + +before_script: + +# Here supply steps such as raco make, raco test, etc. You can run +# `raco pkg install --deps search-auto` to install any required +# packages without it getting stuck on a confirmation prompt. +script: + - raco test -p scribble-enhanced + - raco setup --check-pkg-deps --no-zo --no-launcher --no-install --no-post-install --no-docs --pkgs scribble-enhanced + +after_success: + - raco pkg install --deps search-auto cover cover-coveralls + - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage . diff --git a/LICENSE.txt b/LICENSE.txt @@ -0,0 +1,34 @@ +scribble-enhanced + +Parts of this software were initially written as part of a project at +Cortus, S.A.S. which can be reached at: + Cortus S.A.S., 97 Rue de Freyr, 34000 Montpellier, France. + +This software is licensed under the GNU Lesser General Public License (LGPL). + +This license has been chosen in order to make it possible to integrate +the type-expander library with Typed/Racket +(https://github.com/racket/typed-racket) and/or Racket +(https://github.com/racket/racket), which are both under the LGPL license. + +The original repository from which this package has been extracted +(https://github.com/jsmaniac/phc, see the +fork-from-github-jsmaniac-phc tag) was under a double license (LGPL +and BSD). This choice was made to allow integrating code with Racket +(LGPL) and Typed/Racket (LGPL) as well as with the Nanopass Compiler +Framework (BSD, https://github.com/akeep/nanopass-framework). The BSD +license has been dropped for this package (scribble-enhanced) because +it now contains modified code from the scribble library +(https://github.com/racket/scribble/), which is licensed under the +LGPL license. + +---- + +This package is distributed under the GNU Lesser General Public +License (LGPL). This means that you can link scribble-enhanced into proprietary +applications, provided you follow the rules stated in the LGPL. You +can also modify this package; if you distribute a modified version, +you must distribute it under the terms of the LGPL, which in +particular means that you must release the source code for the +modified software. See http://www.gnu.org/copyleft/lesser.html +for more information. diff --git a/README.md b/README.md @@ -0,0 +1,47 @@ +[](https://travis-ci.org/jsmaniac/scribble-enhanced) +[](https://coveralls.io/github/jsmaniac/scribble-enhanced) +[](http://jsmaniac.github.io/travis-stats/#jsmaniac/scribble-enhanced) +[](http://docs.racket-lang.org/scribble-enhanced/) + +scribble-enhanced +================= + +This `racket` package provides enhancements for the scribble library. + +Installation +------------ + +Install with: + +``` +raco pkg install --deps search-auto scribble-enhanced +``` + +This library is unstable +------------------------ + +For now, this package's API should be considered unstable. +Append `#COMMIT_NUMBER` at the end of `…scribble-enhanced.git` +in the command-line above to specify a version to install +(it will not be automatically updated by `raco pkg update` that way). + +Files +----- + +* `doc.rkt` + Enhancements and utilities for documentation and literate programming files + using scribble and scribble/lp2. + +* `math.rkt` + + Allows typesetting mathematical formulas in documentation and literate + programming files using scribble and scribble/lp2. + +* `scribblings/scribble-enhanced-template.lp2.rkt` + + Example document using the features in `doc.rkt` and `math.rkt`. + +* `scribblings/scribble-enhanced-example.lp2.rkt` + + Other simpler example document using the features in `doc.rkt` and + `math.rkt`. diff --git a/doc.rkt b/doc.rkt @@ -0,0 +1,170 @@ +#lang racket + +;; Math +(require slideshow/pict) +(provide (all-from-out slideshow/pict)) +(require "math.rkt") +(provide (all-from-out "math.rkt")) +; @setup-math is returned in @doc-lib-setup. + + +(require scriblib/render-cond) + +;(require "(submod low.rkt untyped)") +;(#lang reader "scribble-custom/lp2.rkt" #:lang typed/racket) + +;; http://lists.racket-lang.org/users/archive/2015-January/065752.html +;; http://bugs.racket-lang.org/query/?cmd=view%20audit-trail&pr=14068 +;; &database=default +;(require (for-label (only-meta-in 0 typed/racket))) +;(provide (for-label (all-from-out typed/racket))) + +;; ==== remote images ==== +(provide remote-image) +(require (only-in scribble/core make-style) + (only-in scribble/html-properties alt-tag attributes)) +(define (remote-image src alt) + (cond-element + [html (elem + #:style + (make-style #f + (list (alt-tag "img") + (attributes + `((src . ,src) + (alt . ,alt))))))] + [else (elem)])) + +;; ==== hybrid footnotes/margin-note ==== +(provide note) +(require (only-in scriblib/footnote [note footnote]) + (only-in scribble/base margin-note) + (only-in scribble/core nested-flow style)) + +(define (note . args) + (cond-element + [html (element (style "refpara" '()) + (list (element (style "refcolumn" '()) + (list (element (style "refcontent" '()) + (list args))))))] + [else (apply footnote args)])) + +;; ==== ==== + +(require (for-syntax mzlib/etc)) +(define-syntax (doc-lib-setup stx) + ;(display (build-path (this-expression-source-directory) + ; (this-expression-file-name))) + #'setup-math) ;; NOTE: setup-math must be returned, not just called! + +(provide doc-lib-setup) + +;(require (only-in scribble/manual code)) +;(define-syntax-rule (tc . args) +; (code #:lang "typed/racket" . args)) +;(provide tc) + +;(require (only-in scribble/private/lp chunk CHUNK)) +;(provide chunk CHUNK) + + + + + + +;; Copied from the file: +;; /usr/local/racket-6.2.900.6/share/pkgs/scribble-lib/scribble/private/lp.rkt + +(require (for-syntax racket/base syntax/boundmap) + scribble/scheme scribble/decode scribble/manual + (except-in scribble/struct table)) + +(begin-for-syntax + ;; maps chunk identifiers to a counter, so we can distinguish multiple uses + ;; of the same name + (define chunk-numbers (make-free-identifier-mapping)) + (define (get-chunk-number id) + (free-identifier-mapping-get chunk-numbers id (lambda () #f))) + (define (inc-chunk-number id) + (free-identifier-mapping-put! chunk-numbers id + (+ 1 + (free-identifier-mapping-get chunk-numbers + id)))) + (define (init-chunk-number id) + (free-identifier-mapping-put! chunk-numbers id 2))) + +(define-syntax-rule (make-chunk chunk-id racketblock) + (define-syntax (chunk-id stx) + (syntax-case stx () + [(_ name expr (... ...)) + ;; 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 "~a:~a" str (or n 1))]) + + (when n + (inc-chunk-number (syntax-local-introduce #'name))) + + (syntax-local-lift-expression #'(quote-syntax (a-chunk name + expr + (... ...)))) + + (with-syntax ([tag tag] + [str str] + [((for-label-mod (... ...)) (... ...)) + (map (lambda (expr) + (syntax-case expr (require) + [(require mod (... ...)) + (let loop + ([mods (syntax->list #'(mod (... ...)))]) + (cond + [(null? mods) null] + [else + (syntax-case (car mods) (for-syntax) + [(for-syntax x (... ...)) + (append (loop (syntax->list + #'(x (... ...)))) + (loop (cdr mods)))] + [x + (cons #'x (loop (cdr mods)))])]))] + [else null])) + (syntax->list #'(expr (... ...))))] + + [(rest (... ...)) (if n + #`((subscript #,(format "~a" n))) + #`())]) + #`(begin + #,@(if (null? (syntax-e #'(for-label-mod (... ...) (... ...)))) + #'() + #'((require (for-label for-label-mod (... ...) (... ...))))) + #,@(if n + #'() + #'((define-syntax name (make-element-id-transformer + (lambda (stx) #'(chunkref name)))) + (begin-for-syntax (init-chunk-number #'name)))) + ;(make-splice + ;(list (make-toc-element + ;#f + ;(list (elemtag '(chunk tag) + ; (bold (italic (racket name)) " ::="))) + ;(list (smaller (elemref '(chunk tag) #:underline? #f + ; str + ; rest (... ...))))) + (racket expr (... ...)))))]))) ;)) + +(make-chunk chunk2 racketblock) +(make-chunk CHUNK2 RACKETBLOCK) + +(define-syntax (chunkref stx) + (syntax-case stx () + [(_ id) + (identifier? #'id) + (with-syntax ([tag (format "~a:1" (syntax-e #'id))] + [str (format "~a" (syntax-e #'id))]) + #'(elemref '(chunk tag) #:underline? #f str))])) + +(provide chunk2 CHUNK2) + +(provide tc TC) +(define-syntax-rule (tc . rest) (chunk2 name . rest)) +(define-syntax-rule (TC . rest) (CHUNK2 name . rest)) diff --git a/forkmeongithub.rkt b/forkmeongithub.rkt @@ -0,0 +1,84 @@ +#lang racket + +(require scribble/manual + (only-in scribble/core make-style) + (only-in scribble/html-properties alt-tag attributes)) + +(provide forkongithub) + +(define css-code + #<<EOF +#forkongithub a{ + background:#007200; + color:#fff; + text-decoration:none; + font-family:arial,sans-serif; + text-align:center; + font-weight:bold; + font-size:1rem; + line-height:2rem; + position:relative; + /* transition:0.5s; */ +} +#forkongithub a:hover{ + background:#00802B; + color:#fff; +} +#forkongithub a{ + border-radius: 1ex; + box-shadow: inset 0px -1px 4px rgba(255,255,255,0.8); + padding:6.5px 10px 5px 10px; +} +@media screen and (min-width:720px){ + #forkongithub{ + position:absolute; + display:block; + top:0; + right:0; + width:220px; + overflow:hidden; + height:220px; + z-index:9999; + } + #forkongithub a{ + padding:6.5px 40px 5px 40px; + width:210px; + position:absolute; + top:60px; + right:-67px; + transform:rotate(45deg); + -webkit-transform:rotate(45deg); + -ms-transform:rotate(45deg); + -moz-transform:rotate(45deg); + -o-transform:rotate(45deg); + box-shadow: 0px 5px 4px rgba(0,0,0,0.8); + } +#forkongithub a::before, +#forkongithub a::after{ + content:""; + width:100%; + display:block; + position:absolute; + top:2px; + left:0; + height:2px; + background: linear-gradient(90deg, transparent 50%, #bbb 50%) + repeat scroll 0% 0% / 10px; +} +#forkongithub a::after{ + bottom:2px; + top:auto; +} +} +EOF + ) + +(define (forkongithub href text) + (elem + (elem #:style (make-style #f (list (alt-tag "style"))) + css-code) + (elem #:style (make-style #f (list (alt-tag "span") + (attributes '((id . "forkongithub"))))) + (elem #:style (make-style #f (list (alt-tag "a") + (attributes `((href . ,href))))) + text)))) +\ No newline at end of file diff --git a/info.rkt b/info.rkt @@ -0,0 +1,26 @@ +#lang info +(define collection "scribble-enhanced") +(define deps '("base" + "rackunit-lib" + "scribble-lib" + "scheme-lib" + "compatibility-lib" + "slideshow-lib" + "typed-racket-lib" + "reprovide-lang" + "mutable-match-lambda")) +(define build-deps '("scribble-lib" + "racket-doc" + "at-exp-lib" + "typed-racket-more" + "typed-racket-doc" + "scribble-doc")) +(define scribblings + '(("scribblings/scribble-enhanced.scrbl" () ("Scribble Libraries")) + ("scribblings/scribble-enhanced-example.lp2.rkt" () (omit-start)) + ("scribblings/scribble-enhanced-template.lp2.rkt" () (omit-start)))) +(define compile-omit-paths '("resources/")) +(define test-omit-paths '("resources/")) +(define pkg-desc "Enhancements for the scribble language") +(define version "0.3") +(define pkg-authors '(|Suzanne Soy|)) diff --git a/lgpl-3.0--license.txt b/lgpl-3.0--license.txt @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/main.rkt b/main.rkt @@ -0,0 +1,4 @@ +#lang reprovide +scribble-enhanced/manual-form +scribble-enhanced/manual-scheme +scribble-enhanced/racket +\ No newline at end of file diff --git a/manual-form.rkt b/manual-form.rkt @@ -0,0 +1,660 @@ +#lang scheme/base +;; Added #:result option to defform. +;; This file is mostly based on scribble-lib/scribble/private/manual-form.rkt +;; With pieces from scribble-lib/scribble/private/manual-proc.rkt +;; And pieces from scribble-lib/scribble/private/manual-scheme.rkt + +(require scribble/decode + scribble/struct + scribble/scheme + scribble/basic + scribble/manual-struct + scribble/private/qsloc + scribble/private/manual-utils + scribble/private/manual-vars + "manual-scheme.rkt" + scribble/private/manual-bind + scheme/list + syntax/parse/define + (only-in scribble/core + make-style + make-table-columns + make-nested-flow + [make-paragraph make-paragraph2] + nested-flow) + (for-syntax scheme/base + syntax/parse + syntax/srcloc + racket/syntax) + (for-label scheme/base)) + +(provide defform defform* defform/subs defform*/subs defform/none + defidform defidform/inline + specform specform/subs + specsubform specsubform/subs specspecsubform specspecsubform/subs + specsubform/inline + defsubform defsubform* + racketgrammar racketgrammar* + (rename-out [racketgrammar schemegrammar] + [racketgrammar* schemegrammar*]) + var svar + (for-syntax kind-kw id-kw link-target?-kw + literals-kw subs-kw contracts-kw)) + +(begin-for-syntax + (define-splicing-syntax-class kind-kw + #:description "#:kind keyword" + (pattern (~seq #:kind kind)) + (pattern (~seq) + #:with kind #'#f)) + + (define-splicing-syntax-class id-kw + #:description "#:id keyword" + (pattern (~seq #:id [defined-id:id defined-id-expr])) + (pattern (~seq #:id defined-id:id) + #:with defined-id-expr #'(quote-syntax defined-id)) + (pattern (~seq #:id [#f #f]) + #:with defined-id #'#f + #:with defined-id-expr #'#f) + (pattern (~seq) + #:with defined-id #'#f + #:with defined-id-expr #'#f)) + + (define-splicing-syntax-class link-target?-kw + #:description "#:link-target? keyword" + (pattern (~seq #:link-target? expr)) + (pattern (~seq) + #:with expr #'#t)) + + (define-splicing-syntax-class literals-kw + #:description "#:literals keyword" + (pattern (~seq #:literals (lit:id ...))) + (pattern (~seq) + #:with (lit ...) #'())) + + (define-splicing-syntax-class result-kw + #:description "#:literals keyword" + (pattern (~seq #:result r) + #:with maybe-result #'(r)) + (pattern (~seq) + #:with maybe-result #'())) + (define-splicing-syntax-class results-kw + #:description "#:literals keyword" + (pattern (~seq #:results (result ...)))) + + (define-splicing-syntax-class contracts-kw + #:description "#:contracts keyword" + (pattern (~seq #:contracts (~and cs ([contract-nonterm:id contract-expr] ...)))) + (pattern (~seq) + #:with (~and cs ((contract-nonterm contract-expr) ...)) #'())) + + (define-syntax-class grammar + #:description "grammar" + (pattern ([non-term-id:id non-term-form ...+] ...))) + + (define-splicing-syntax-class subs-kw + #:description "#:grammar keyword" + #:attributes (g (g.non-term-id 1) (g.non-term-form 2)) + (pattern (~seq #:grammar g:grammar)) + (pattern (~seq) #:with g:grammar #'())) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Adjusted from manual-scheme.rkt +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-syntax-rule (define-/form* id base) + (define-syntax (id stx) + (syntax-case stx () + [(_ . a) + ;; Remove the context from any ellipsis in `a`: + (with-syntax ([a (strip-ellipsis-context #'a)]) + #'(base . a))]))) + +(define-for-syntax (strip-ellipsis-context a) + (define a-ellipsis (datum->syntax a '...)) + (let loop ([a a]) + (cond + [(identifier? a) + (if (free-identifier=? a a-ellipsis #f) + (datum->syntax #f '... a a) + a)] + [(syntax? a) + (datum->syntax a (loop (syntax-e a)) a a)] + [(pair? a) + (cons (loop (car a)) + (loop (cdr a)))] + [(vector? a) + (list->vector + (map loop (vector->list a)))] + [(box? a) + (box (loop (unbox a)))] + [(prefab-struct-key a) + => (lambda (k) + (apply make-prefab-struct + k + (loop (cdr (vector->list (struct->vector a))))))] + [else a]))) + +(define-/form* racketblock0/form* racketblock0) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; From manual-proc.rkt +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-syntax (result-contract stx) + (syntax-case stx (values) + [(_ (values c ...)) + #'(list (racketblock0 c) ...)] + [(_ c) + (if (string? (syntax-e #'c)) + (raise-syntax-error 'defproc + "expected a result contract, found a string" #'c) + #'(racketblock0 c))] + [(_) + #'#f])) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Adjusted from manual-proc.rkt +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (end result-contract) + (define res + (let ([res (result-contract)]) + (and res + (if (list? res) + ;; multiple results + (if (null? res) + 'nbsp + (let ([w (apply + (map block-width res))]) + (if (or (ormap table? res) (w . > . 40)) + (make-table + #f (map (lambda (fe) (list (make-flow (list fe)))) res)) + (make-table + #f + (list (let loop ([res res]) + (if (null? (cdr res)) + (list (make-flow (list (car res)))) + (list* (make-flow (list (car res))) + flow-spacer + (loop (cdr res)))))))))) + res)))) + (if res + (list flow-spacer (to-flow 'rarr) + flow-spacer (make-flow (list res))) + (list))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-syntax (defform*/subs stx) + (syntax-parse stx + [(_ k:kind-kw lt:link-target?-kw d:id-kw l:literals-kw [spec spec1 ...] + (~optional results:results-kw) + g:grammar + c:contracts-kw + desc ...) + (with-syntax* ([defined-id (if (syntax-e #'d.defined-id) + #'d.defined-id + (syntax-case #'spec () + [(spec-id . _) #'spec-id]))] + [defined-id-expr (if (syntax-e #'d.defined-id-expr) + #'d.defined-id-expr + #'(quote-syntax defined-id))] + [(new-spec ...) + (for/list ([spec (in-list (syntax->list #'(spec spec1 ...)))]) + (let loop ([spec spec]) + (if (and (identifier? spec) + (free-identifier=? spec #'defined-id)) + (datum->syntax #'here '(unsyntax x) spec spec) + #;(syntax-case spec () + [(a . b) + (datum->syntax spec + (cons (loop #'a) (loop #'b)) + spec + spec)] + [id + (and (identifier? #'id) + (or (free-identifier=? #'id #'syntax) + (free-identifier=? #'id #'unsyntax) + (free-identifier=? #'id #'quasisyntax))) + (if (= (source-location-span #'id) 2) + (datum->syntax #'here + `(unsyntax ',(syntax-e #'id)) + spec + spec) + (datum->syntax #'here + `(unsyntax (RACKET ,(syntax-e #'id))) + spec + spec))]) + + + (cond + [(and (identifier? spec) + (or (free-identifier=? spec #'quote) + (free-identifier=? spec #'unquote) + (free-identifier=? spec #'quasiquote))) + (if (= (source-location-span spec) 1) + (datum->syntax #'here + `(unsyntax ',(syntax-e spec)) + spec + spec) + (datum->syntax #'here + `(unsyntax (RACKET ,(syntax-e spec))) + spec + spec))] + [(and (identifier? spec) + (or (free-identifier=? spec #'syntax) + (free-identifier=? spec #'unsyntax) + (free-identifier=? spec #'quasisyntax))) + (if (= (source-location-span spec) 2) + (datum->syntax #'here + `(unsyntax ',(syntax-e spec)) + spec + spec) + (datum->syntax #'here + `(unsyntax (RACKET ,(syntax-e spec))) + spec + spec))] + [(syntax? spec) (datum->syntax spec + (loop (syntax-e spec)) + spec + spec)] + [(pair? spec) (cons (loop (car spec)) + (loop (cdr spec)))] + [else spec]))))] + [(maybe-result ...) (if (attribute results) + #'(results.result ...) + (map (λ _ #'()) + (syntax->list #'(spec spec1 ...))))]) + #'(with-togetherable-racket-variables + (l.lit ...) + ([form [defined-id spec]] [form [defined-id spec1]] ... + [non-term (g.non-term-id g.non-term-form ...)] ...) + (*defforms k.kind lt.expr defined-id-expr + '(spec spec1 ...) + (list + (lambda (x) + (top-align + make-table + "prototype" + (list + (list (list (racketblock0/form* new-spec))) + (list (list (make-flow (top-align + make-table + "prototype" + (list (end (λ () (result-contract . maybe-result))))))))))) + ...) + '((g.non-term-id g.non-term-form ...) ...) + (list (list (lambda () (racket g.non-term-id)) + (lambda () (racketblock0/form g.non-term-form)) + ...) + ...) + (list (list (lambda () (racket c.contract-nonterm)) + (lambda () (racketblock0 c.contract-expr))) + ...) + (lambda () (list desc ...)))))])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; From manual-proc +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define top-align-styles (make-hash)) +(define (top-align make-table style-name cols) + (if (null? cols) + (make-table style-name null) + (let* ([n (length (car cols))] + [k (cons style-name n)]) + (make-table + (hash-ref top-align-styles + k + (lambda () + (define s + (make-style style-name + (list (make-table-columns (for/list ([i n]) + (make-style #f '(top))))))) + (hash-set! top-align-styles k s) + s)) + cols)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-syntax (defform* stx) + (syntax-parse stx + [(_ k:kind-kw lt:link-target?-kw d:id-kw l:literals-kw [spec ...] + (~optional r:results-kw) + subs:subs-kw c:contracts-kw desc ...) + (quasisyntax/loc stx + (defform*/subs #:kind k.kind + #:link-target? lt.expr + #:id [d.defined-id d.defined-id-expr] + #:literals (l.lit ...) + [spec ...] + #,@(if (attribute r) #'(#:results [r.result ...]) #'()) + subs.g #:contracts c.cs desc ...))])) + +(define-syntax (defform stx) + (syntax-parse stx + [(_ k:kind-kw lt:link-target?-kw d:id-kw l:literals-kw spec + r:result-kw + subs:subs-kw c:contracts-kw desc ...) + (syntax/loc stx + (defform*/subs #:kind k.kind + #:link-target? lt.expr + #:id [d.defined-id d.defined-id-expr] + #:literals (l.lit ...) + [spec] #:results [r.maybe-result] subs.g #:contracts c.cs desc ...))])) + +(define-syntax (defform/subs stx) + (syntax-parse stx + [(_ k:kind-kw lt:link-target?-kw d:id-kw l:literals-kw spec r:result-kw subs desc ...) + (syntax/loc stx + (defform*/subs #:kind k.kind + #:link-target? lt.expr + #:id [d.defined-id d.defined-id-expr] + #:literals (l.lit ...) + [spec] #:results [r.maybe-result] subs desc ...))])) + +(define-syntax (defform/none stx) + (syntax-parse stx + [(_ k:kind-kw lt:link-target?-kw l:literals-kw spec subs:subs-kw c:contracts-kw desc ...) + (syntax/loc stx + (with-togetherable-racket-variables + (l.lit ...) + ([form/none spec] + [non-term (subs.g.non-term-id subs.g.non-term-form ...)] ...) + (*defforms k.kind lt.expr #f + '(spec) + (list (lambda (ignored) (racketblock0/form spec))) + '((subs.g.non-term-id subs.g.non-term-form ...) ...) + (list (list (lambda () (racket subs.g.non-term-id)) + (lambda () (racketblock0/form subs.g.non-term-form)) + ...) + ...) + (list (list (lambda () (racket c.contract-nonterm)) + (lambda () (racketblock0 c.contract-expr))) + ...) + (lambda () (list desc ...)))))])) + +(define-syntax (defidform/inline stx) + (syntax-case stx (unsyntax) + [(_ id) + (identifier? #'id) + #'(defform-site (quote-syntax id))] + [(_ (unsyntax id-expr)) + #'(defform-site id-expr)])) + +(define-syntax (defidform stx) + (syntax-parse stx + [(_ k:kind-kw lt:link-target?-kw spec-id desc ...) + #'(with-togetherable-racket-variables + () + () + (*defforms k.kind lt.expr (quote-syntax/loc spec-id) + '(spec-id) + (list (lambda (x) (make-omitable-paragraph (list x)))) + null + null + null + (lambda () (list desc ...))))])) + +(define (into-blockquote s) + (make-blockquote "leftindent" + (if (splice? s) + (flow-paragraphs (decode-flow (splice-run s))) + (list s)))) + +(define-syntax (defsubform stx) + (syntax-case stx () + [(_ . rest) #'(into-blockquote (defform . rest))])) + +(define-syntax (defsubform* stx) + (syntax-case stx () + [(_ . rest) #'(into-blockquote (defform* . rest))])) + +(define-syntax (spec?form/subs stx) + (syntax-parse stx + [(_ has-kw? l:literals-kw (~or (~seq #:unwrap (spec ...)) + (~and (~seq spec0) (~seq spec ...))) + g:grammar + c:contracts-kw + desc ...) + #:with spec* (or (attribute spec0) #'(spec ...)) + (syntax/loc stx + (with-racket-variables + (l.lit ...) + ([form/maybe (has-kw? spec*)] + [non-term (g.non-term-id g.non-term-form ...)] ...) + (*specsubform 'spec* '(l.lit ...) (lambda () (racketblock0/form* spec ...)) + '((g.non-term-id g.non-term-form ...) ...) + (list (list (lambda () (racket g.non-term-id)) + (lambda () (racketblock0/form g.non-term-form)) + ...) + ...) + (list (list (lambda () (racket c.contract-nonterm)) + (lambda () (racketblock0 c.contract-expr))) + ...) + (lambda () (list desc ...)))))])) + +(begin-for-syntax + (define-splicing-syntax-class unwrappable-spec + (pattern (~seq #:unwrap s) #:with (m-u-spec ...) #'(#:unwrap s)) + (pattern (~seq spec) #:with (m-u-spec ...) #'(spec)))) + +(define-syntax (specsubform stx) + (syntax-parse stx + [(_ l:literals-kw :unwrappable-spec subs:subs-kw c:contracts-kw desc ...) + (syntax/loc stx + (spec?form/subs #f #:literals (l.lit ...) m-u-spec ... subs.g #:contracts c.cs desc ...))])) + +(define-syntax (specsubform/subs stx) + (syntax-parse stx + [(_ l:literals-kw :unwrappable-spec g:grammar desc ...) + (syntax/loc stx + (spec?form/subs #f #:literals (l.lit ...) m-u-spec ... + ([g.non-term-id g.non-term-form ...] ...) + desc ...))])) + +(define-simple-macro (specspecsubform :unwrappable-spec desc ...) + (make-blockquote "leftindent" (list (specsubform m-u-spec ... desc ...)))) + +(define-simple-macro (specspecsubform/subs :unwrappable-spec subs desc ...) + (make-blockquote "leftindent" (list (specsubform/subs m-u-spec ... subs desc ...)))) + +(define-syntax (specform stx) + (syntax-parse stx + [(_ l:literals-kw spec subs:subs-kw c:contracts-kw desc ...) + (syntax/loc stx + (spec?form/subs #t #:literals (l.lit ...) spec subs.g #:contracts c.cs desc ...))])) + +(define-syntax (specform/subs stx) + (syntax-parse stx + [(_ l:literals-kw spec g:grammar + desc ...) + (syntax/loc stx + (spec?form/subs #t #:literals (l.lit ...) spec ([g.non-term-id g.non-term-form ...] ...) + desc ...))])) + +(define-syntax-rule (specsubform/inline spec desc ...) + (with-racket-variables + () + ([form/maybe (#f spec)]) + (*specsubform 'spec null #f null null null (lambda () (list desc ...))))) + +(define-syntax racketgrammar + (syntax-rules () + [(_ #:literals (lit ...) id clause ...) + (racketgrammar* #:literals (lit ...) [id clause ...])] + [(_ id clause ...) (racketgrammar #:literals () id clause ...)])) + +(define-syntax racketgrammar* + (syntax-rules () + [(_ #:literals (lit ...) [id clause ...] ...) + (with-racket-variables + (lit ...) + ([non-term (id clause ...)] ...) + (*racketgrammar '(lit ...) + '(id ... clause ... ...) + (lambda () + (list (list (racket id) + (racketblock0/form clause) ...) + ...))))] + [(_ [id clause ...] ...) + (racketgrammar* #:literals () [id clause ...] ...)])) + +(define-syntax-rule (var id) + (*var 'id)) + +(define-syntax-rule (svar id) + (*var 'id)) + + +(define (meta-symbol? s) (memq s '(... ...+ ?))) + +(define (defform-site kw-id) + (let ([target-maker (id-to-form-target-maker kw-id #t)]) + (define-values (content ref-content) (definition-site (syntax-e kw-id) kw-id #t)) + (if target-maker + (target-maker + content + (lambda (tag) + (make-toc-target2-element + #f + (if kw-id + (make-index-element + #f content tag + (list (datum-intern-literal (symbol->string (syntax-e kw-id)))) + (list ref-content) + (with-exporting-libraries + (lambda (libs) + (make-form-index-desc (syntax-e kw-id) + libs)))) + content) + tag + ref-content))) + content))) + +(define (*defforms kind link? kw-id forms form-procs subs sub-procs contract-procs content-thunk) + (parameterize ([current-meta-list '(... ...+)]) + (make-box-splice + (cons + (make-blockquote + vertical-inset-style + (list + (make-table + boxed-style + (append + (for/list ([form (in-list forms)] + [form-proc (in-list form-procs)] + [i (in-naturals)]) + (list + ((if (zero? i) (add-background-label (or kind "syntax")) values) + ;(list + ;(make-nested-flow (make-style #f '()) + (list + ((or form-proc + (lambda (x) + (make-omitable-paragraph + (list (to-element `(,x . ,(cdr form))))))) + (and kw-id + (if (eq? form (car forms)) + (if link? + (defform-site kw-id) + (to-element #:defn? #t kw-id)) + (to-element #:defn? #t kw-id)))))))) + (if (null? sub-procs) + null + (list (list flow-empty-line) + (list (make-flow + (list (let ([l (map (lambda (sub) + (map (lambda (f) (f)) sub)) + sub-procs)]) + (*racketrawgrammars "specgrammar" + (map car l) + (map cdr l)))))))) + (make-contracts-table contract-procs))))) + (content-thunk))))) + +(define (*specsubform form lits form-thunk subs sub-procs contract-procs content-thunk) + (parameterize ([current-meta-list '(... ...+)]) + (make-blockquote + "leftindent" + (cons + (make-blockquote + vertical-inset-style + (list + (make-table + boxed-style + (cons + (list + (make-flow + (list + (if form-thunk + (form-thunk) + (make-omitable-paragraph (list (to-element form))))))) + (append + (if (null? sub-procs) + null + (list (list flow-empty-line) + (list (make-flow + (list (let ([l (map (lambda (sub) + (map (lambda (f) (f)) sub)) + sub-procs)]) + (*racketrawgrammars "specgrammar" + (map car l) + (map cdr l)))))))) + (make-contracts-table contract-procs)))))) + (flow-paragraphs (decode-flow (content-thunk))))))) + +(define (*racketrawgrammars style nonterms clauseses) + (make-table + `((valignment baseline baseline baseline baseline baseline) + (alignment right left center left left) + (style ,style)) + (cdr + (append-map + (lambda (nonterm clauses) + (list* + (list flow-empty-line flow-empty-line flow-empty-line + flow-empty-line flow-empty-line) + (list (to-flow nonterm) flow-empty-line (to-flow "=") flow-empty-line + (make-flow (list (car clauses)))) + (map (lambda (clause) + (list flow-empty-line flow-empty-line + (to-flow "|") flow-empty-line + (make-flow (list clause)))) + (cdr clauses)))) + nonterms clauseses)))) + +(define (*racketrawgrammar style nonterm clause1 . clauses) + (*racketrawgrammars style (list nonterm) (list (cons clause1 clauses)))) + +(define (*racketgrammar lits s-expr clauseses-thunk) + (let ([l (clauseses-thunk)]) + (*racketrawgrammars #f + (map (lambda (x) + (make-element #f + (list (hspace 2) + (car x)))) + l) + (map cdr l)))) + +(define (*var id) + (to-element (*var-sym id))) + +(define (*var-sym id) + (string->symbol (format "_~a" id))) + +(define (make-contracts-table contract-procs) + (if (null? contract-procs) + null + (append + (list (list flow-empty-line)) + (list (list (make-flow + (map (lambda (c) + (make-table + "argcontract" + (list + (list (to-flow (hspace 2)) + (to-flow ((car c))) + flow-spacer + (to-flow ":") + flow-spacer + (make-flow (list ((cadr c)))))))) + contract-procs))))))) diff --git a/manual-scheme.rkt b/manual-scheme.rkt @@ -0,0 +1,291 @@ +#lang racket/base +(require scribble/decode + scribble/struct + "racket.rkt";; was: "../scheme.rkt" + scribble/search + scribble/basic + (only-in scribble/core style style-properties) + scribble/private/manual-style + scribble/private/manual-utils ;; used via datum->syntax + scribble/private/on-demand + (for-syntax racket/base) + (for-label racket/base)) + +(provide racketblock RACKETBLOCK racketblock/form + racketblock0 RACKETBLOCK0 racketblock0/form + racketresultblock racketresultblock0 + RACKETRESULTBLOCK RACKETRESULTBLOCK0 + racketblockelem + racketinput RACKETINPUT + racketinput0 RACKETINPUT0 + racketmod + racketmod0 + racket RACKET racket/form racketresult racketid + racketmodname + racketmodlink indexed-racket + racketlink + + (rename-out [racketblock schemeblock] + [RACKETBLOCK SCHEMEBLOCK] + [racketblock/form schemeblock/form] + [racketblock0 schemeblock0] + [RACKETBLOCK0 SCHEMEBLOCK0] + [racketblock0/form schemeblock0/form] + [racketblockelem schemeblockelem] + [racketinput schemeinput] + [racketmod schememod] + [racket scheme] + [RACKET SCHEME] + [racket/form scheme/form] + [racketresult schemeresult] + [racketid schemeid] + [racketmodname schememodname] + [racketmodlink schememodlink] + [indexed-racket indexed-scheme] + [racketlink schemelink])) + +(define-code racketblock0 to-paragraph) +(define-code racketblock to-block-paragraph) +(define-code RACKETBLOCK to-block-paragraph UNSYNTAX) +(define-code RACKETBLOCK0 to-paragraph UNSYNTAX) + +(define (to-block-paragraph v) + (code-inset (to-paragraph v))) + +(define (to-result-paragraph v) + (to-paragraph v + #:color? #f + #:wrap-elem + (lambda (e) (make-element result-color e)))) +(define (to-result-paragraph/prefix a b c) + (let ([to-paragraph (to-paragraph/prefix a b c)]) + (lambda (v) + (to-paragraph v + #:color? #f + #:wrap-elem + (lambda (e) (make-element result-color e)))))) + +(define-code racketresultblock0 to-result-paragraph) +(define-code racketresultblock (to-result-paragraph/prefix (hspace 2) (hspace 2) "")) +(define-code RACKETRESULTBLOCK (to-result-paragraph/prefix (hspace 2) (hspace 2) "") + UNSYNTAX) +(define-code RACKETRESULTBLOCK0 to-result-paragraph UNSYNTAX) + +(define interaction-prompt (make-element 'tt (list "> " ))) +(define-code racketinput to-input-paragraph/inset) +(define-code RACKETINPUT to-input-paragraph/inset) +(define-code racketinput0 to-input-paragraph) +(define-code RACKETINPUT0 to-input-paragraph) + +(define to-input-paragraph + (to-paragraph/prefix + (make-element #f interaction-prompt) + (hspace 2) + "")) + +(define to-input-paragraph/inset + (lambda (v) + (code-inset (to-input-paragraph v)))) + +(define-syntax (racketmod0 stx) + (syntax-case stx () + [(_ #:file filename #:escape unsyntax-id lang rest ...) + (with-syntax ([modtag (datum->syntax + #'here + `(unsyntax (make-element + #f + (list (hash-lang) + spacer + ,(if (identifier? #'lang) + `(as-modname-link + ',#'lang + (to-element ',#'lang) + #f) + #'(racket lang))))) + #'lang)]) + (if (syntax-e #'filename) + (quasisyntax/loc stx + (filebox + filename + #,(syntax/loc stx (racketblock0 #:escape unsyntax-id modtag rest ...)))) + (syntax/loc stx (racketblock0 #:escape unsyntax-id modtag rest ...))))] + [(_ #:file filename lang rest ...) + (syntax/loc stx (racketmod0 #:file filename #:escape unsyntax lang rest ...))] + [(_ lang rest ...) + (syntax/loc stx (racketmod0 #:file #f lang rest ...))])) + +(define-syntax-rule (racketmod rest ...) + (code-inset (racketmod0 rest ...))) + +(define (to-element/result s) + (make-element result-color (list (to-element/no-color s)))) +(define (to-element/id s) + (make-element symbol-color (list (to-element/no-color s)))) + +(define-syntax (keep-s-expr stx) + (syntax-case stx (quote) + [(_ ctx '#t #(src line col pos 5)) + #'(make-long-boolean #t)] + [(_ ctx '#f #(src line col pos 6)) + #'(make-long-boolean #f)] + [(_ ctx s srcloc) + (let ([sv (syntax-e + (syntax-case #'s (quote) + [(quote s) #'s] + [_ #'s]))]) + (if (or (number? sv) + (boolean? sv) + (and (pair? sv) + (identifier? (car sv)) + (or (free-identifier=? #'cons (car sv)) + (free-identifier=? #'list (car sv))))) + ;; We know that the context is irrelvant + #'s + ;; Context may be relevant: + #'(*keep-s-expr s ctx)))])) +(define (*keep-s-expr s ctx) + (if (symbol? s) + (make-just-context s ctx) + s)) + +(define (add-sq-prop s name val) + (if (eq? name 'paren-shape) + (make-shaped-parens s val) + s)) + +(define-code racketblockelem to-element) + +(define-code racket to-element unsyntax keep-s-expr add-sq-prop) +(define-code RACKET to-element UNSYNTAX keep-s-expr add-sq-prop) +(define-code racketresult to-element/result unsyntax keep-s-expr add-sq-prop) +(define-code racketid to-element/id unsyntax keep-s-expr add-sq-prop) +(define-code *racketmodname to-element unsyntax keep-s-expr add-sq-prop) + +(define-syntax (**racketmodname stx) + (syntax-case stx () + [(_ form) + (let ([stx #'form]) + #`(*racketmodname + ;; We want to remove lexical context from identifiers + ;; that correspond to module names, but keep context + ;; for `lib' or `planet' (which are rarely used) + #,(if (identifier? stx) + (datum->syntax #f (syntax-e stx) stx stx) + (if (and (pair? (syntax-e stx)) + (memq (syntax-e (car (syntax-e stx))) '(lib planet file))) + (let ([s (car (syntax-e stx))] + [rest (let loop ([a (cdr (syntax-e stx))] [head? #f]) + (cond + [(identifier? a) (datum->syntax #f (syntax-e a) a a)] + [(and head? (pair? a) (and (identifier? (car a)) + (free-identifier=? #'unsyntax (car a)))) + a] + [(pair? a) (cons (loop (car a) #t) + (loop (cdr a) #f))] + [(syntax? a) (datum->syntax a + (loop (syntax-e a) head?) + a + a)] + [else a]))]) + (datum->syntax stx (cons s rest) stx stx)) + stx))))])) + +(define-syntax racketmodname + (syntax-rules (unsyntax) + [(racketmodname #,n) + (let ([sym n]) + (as-modname-link sym (to-element sym) #f))] + [(racketmodname n) + (as-modname-link 'n (**racketmodname n) #f)] + [(racketmodname #,n #:indirect) + (let ([sym n]) + (as-modname-link sym (to-element sym) #t))] + [(racketmodname n #:indirect) + (as-modname-link 'n (**racketmodname n) #t)])) + +(define-syntax racketmodlink + (syntax-rules (unsyntax) + [(racketmodlink n content ...) + (*as-modname-link 'n (elem #:style #f content ...) #f)])) + +(define (as-modname-link s e indirect?) + (if (symbol? s) + (*as-modname-link s e indirect?) + e)) + +(define-on-demand indirect-module-link-color + (struct-copy style module-link-color + [properties (cons 'indirect-link + (style-properties module-link-color))])) + +(define (*as-modname-link s e indirect?) + (make-link-element (if indirect? + indirect-module-link-color + module-link-color) + (list e) + `(mod-path ,(datum-intern-literal (format "~s" s))))) + +(define-syntax-rule (indexed-racket x) + (add-racket-index 'x (racket x))) + +(define (add-racket-index s e) + (let ([k (cond [(and (pair? s) (eq? (car s) 'quote)) (format "~s" (cadr s))] + [(string? s) s] + [else (format "~s" s)])]) + (index* (list k) (list e) e))) + +(define-syntax-rule (define-/form id base) + (define-syntax (id stx) + (syntax-case stx () + [(_ a) + ;; Remove the context from any ellipsis in `a`: + (with-syntax ([a (strip-ellipsis-context #'a)]) + #'(base a))]))) + +(define-for-syntax (strip-ellipsis-context a) + (define a-ellipsis (datum->syntax a '...)) + (let loop ([a a]) + (cond + [(identifier? a) + (if (free-identifier=? a a-ellipsis #f) + (datum->syntax #f '... a a) + a)] + [(syntax? a) + (datum->syntax a (loop (syntax-e a)) a a)] + [(pair? a) + (cons (loop (car a)) + (loop (cdr a)))] + [(vector? a) + (list->vector + (map loop (vector->list a)))] + [(box? a) + (box (loop (unbox a)))] + [(prefab-struct-key a) + => (lambda (k) + (apply make-prefab-struct + k + (loop (cdr (vector->list (struct->vector a))))))] + [else a]))) + +(define-/form racketblock0/form racketblock0) +(define-/form racketblock/form racketblock) +(define-/form racket/form racket) + +(define (*racketlink stx-id id style . s) + (let ([content (decode-content s)]) + (make-delayed-element + (lambda (r p ri) + (make-link-element + style + content + (or (find-racket-tag p ri stx-id #f) + `(undef ,(format "--UNDEFINED:~a--" (syntax-e stx-id)))))) + (lambda () content) + (lambda () content)))) + +(define-syntax racketlink + (syntax-rules () + [(_ id #:style style . content) + (*racketlink (quote-syntax id) 'id style . content)] + [(_ id . content) + (*racketlink (quote-syntax id) 'id #f . content)])) diff --git a/math.rkt b/math.rkt @@ -0,0 +1,38 @@ +#lang at-exp racket + +(provide setup-math) + +(require scribble/html-properties + scribble/latex-properties + scribble/base + scribble/core) + +(require scriblib/render-cond) + +(require "unicode-chars.sty.rkt") + +(define setup-math + (cond-element + [(and (or html)) + (elem #:style (style #f (list)) '())] + [latex + (elem #:style (style + #f (list (tex-addition (string->bytes/utf-8 @string-append{ +%\overfullrule=2cm +\usepackage[scaled=0.7]{beramono} +\usepackage{newunicodechar} +%\newunicodechar{ᵢ}{\ensuremath{_1}} + +\usepackage{xcolor} +\hypersetup{ + unicode=true, + colorlinks=true, + linkcolor={red!50!white!50!black}, + citecolor={blue!50!black}, + urlcolor={blue!80!black}, +} + +@unicode-chars +})))) + "")] + [else (elem)])) diff --git a/racket.rkt b/racket.rkt @@ -0,0 +1,1447 @@ +#lang racket/base +(require scribble/core + scribble/basic + scribble/search + scribble/private/manual-sprop + scribble/private/on-demand + scribble/html-properties + file/convertible + racket/extflonum + (for-syntax racket/base)) + +(provide define-code + to-element + to-element/no-color + to-paragraph + to-paragraph/prefix + syntax-ize + syntax-ize-hook + current-keyword-list + current-variable-list + current-meta-list + + input-color + output-color + input-background-color + no-color + reader-color + result-color + keyword-color + comment-color + paren-color + meta-color + value-color + symbol-color + variable-color + opt-color + error-color + syntax-link-color + value-link-color + syntax-def-color + value-def-color + module-color + module-link-color + block-color + highlighted-color + + (struct-out var-id) + (struct-out shaped-parens) + (struct-out long-boolean) + (struct-out just-context) + (struct-out alternate-display) + (struct-out literal-syntax) + (for-syntax make-variable-id + variable-id? + make-element-id-transformer + element-id-transformer?)) + +(define (make-racket-style s + #:tt? [tt? #t] + #:extras [extras null]) + (make-style s (if tt? + (cons 'tt-chars + (append extras + scheme-properties)) + (append extras + scheme-properties)))) + +(define-on-demand output-color (make-racket-style "RktOut")) +(define-on-demand input-color (make-racket-style "RktIn")) +(define-on-demand input-background-color (make-racket-style "RktInBG")) +(define-on-demand no-color (make-racket-style "RktPlain")) +(define-on-demand reader-color (make-racket-style "RktRdr")) +(define-on-demand result-color (make-racket-style "RktRes")) +(define-on-demand keyword-color (make-racket-style "RktKw")) +(define-on-demand comment-color (make-racket-style "RktCmt")) +(define-on-demand paren-color (make-racket-style "RktPn")) +(define-on-demand meta-color (make-racket-style "RktMeta")) +(define-on-demand value-color (make-racket-style "RktVal")) +(define-on-demand symbol-color (make-racket-style "RktSym")) +(define-on-demand symbol-def-color (make-racket-style "RktSymDef" + #:extras (list (attributes '((class . "RktSym")))))) +(define-on-demand variable-color (make-racket-style "RktVar")) +(define-on-demand opt-color (make-racket-style "RktOpt")) +(define-on-demand error-color (make-racket-style "RktErr" #:tt? #f)) +(define-on-demand syntax-link-color (make-racket-style "RktStxLink")) +(define-on-demand value-link-color (make-racket-style "RktValLink")) +(define-on-demand syntax-def-color (make-racket-style "RktStxDef" + #:extras (list (attributes '((class . "RktStxLink")))))) +(define-on-demand value-def-color (make-racket-style "RktValDef" + #:extras (list (attributes '((class . "RktValLink")))))) +(define-on-demand module-color (make-racket-style "RktMod")) +(define-on-demand module-link-color (make-racket-style "RktModLink")) +(define-on-demand block-color (make-racket-style "RktBlk")) +(define-on-demand highlighted-color (make-racket-style "highlighted" #:tt? #f)) + +(define current-keyword-list + (make-parameter null)) +(define current-variable-list + (make-parameter null)) +(define current-meta-list + (make-parameter null)) + +(define defined-names (make-hasheq)) + +(define-struct (sized-element element) (length)) + +(define-struct (spaces element) (cnt)) + +;; We really don't want leading hypens (or minus signs) to +;; create a line break after the hyphen. For interior hyphens, +;; line breaking is usually fine. +(define (nonbreak-leading-hyphens s) + (let ([m (regexp-match-positions #rx"^-+" s)]) + (if m + (if (= (cdar m) (string-length s)) + (make-element 'no-break s) + (let ([len (add1 (cdar m))]) + (make-element #f (list (make-element 'no-break (substring s 0 len)) + (substring s len))))) + s))) + +(define (literalize-spaces i [leading? #f]) + (let ([m (regexp-match-positions #rx" +" i)]) + (if m + (let ([cnt (- (cdar m) (caar m))]) + (make-spaces #f + (list + (literalize-spaces (substring i 0 (caar m)) #t) + (hspace cnt) + (literalize-spaces (substring i (cdar m)))) + cnt)) + (if leading? + (nonbreak-leading-hyphens i) + i)))) + + +(define line-breakable-space (make-element 'tt " ")) + +;; These caches intentionally record a key with the value. +;; That way, when the value is no longer used, the key +;; goes away, and the entry is gone. + +(define id-element-cache (make-weak-hash)) +(define element-cache (make-weak-hash)) + +(define-struct (cached-delayed-element delayed-element) (cache-key)) +(define-struct (cached-element element) (cache-key)) + +(define qq-ellipses (string->uninterned-symbol "...")) + +(define (make-id-element c s defn?) + (let* ([key (and id-element-cache + (let ([b (identifier-label-binding c)]) + (vector (syntax-e c) + (module-path-index->taglet (caddr b)) + (cadddr b) + (list-ref b 5) + (syntax-property c 'display-string) + defn?)))]) + (or (and key + (let ([b (hash-ref id-element-cache key #f)]) + (and b + (weak-box-value b)))) + (let ([e (make-cached-delayed-element + (lambda (renderer sec ri) + (let* ([tag (find-racket-tag sec ri c #f)]) + (if tag + (let ([tag (intern-taglet tag)]) + (list + (case (car tag) + [(form) + (make-link-element (if defn? + syntax-def-color + syntax-link-color) + (nonbreak-leading-hyphens s) + tag)] + [else + (make-link-element (if defn? + value-def-color + value-link-color) + (nonbreak-leading-hyphens s) + tag)]))) + (list + (make-element "badlink" + (make-element value-link-color s)))))) + (lambda () s) + (lambda () s) + (intern-taglet key))]) + (when key + (hash-set! id-element-cache key (make-weak-box e))) + e)))) + +(define (make-element/cache style content) + (if (and element-cache + (string? content)) + (let ([key (vector style content)]) + (let ([b (hash-ref element-cache key #f)]) + (or (and b (weak-box-value b)) + (let ([e (make-cached-element style content key)]) + (hash-set! element-cache key (make-weak-box e)) + e)))) + (make-element style content))) + +(define (to-quoted obj expr? quote-depth out color? inc!) + (if (and expr? + (zero? quote-depth) + (quotable? obj)) + (begin + (out "'" (and color? value-color)) + (inc!) + (add1 quote-depth)) + quote-depth)) + +(define (to-unquoted expr? quote-depth out color? inc!) + (if (or (not expr?) (zero? quote-depth)) + quote-depth + (begin + (out "," (and color? meta-color)) + (inc!) + (to-unquoted expr? (sub1 quote-depth) out color? inc!)))) + +(define iformat + (case-lambda + [(str val) (datum-intern-literal (format str val))] + [(str . vals) (datum-intern-literal (apply format str vals))])) + +(define (typeset-atom c out color? quote-depth expr? escapes? defn?) + (if (and (var-id? (syntax-e c)) + (zero? quote-depth)) + (out (iformat "~s" (let ([v (var-id-sym (syntax-e c))]) + (if (syntax? v) + (syntax-e v) + v))) + variable-color) + (let*-values ([(is-var?) (and (identifier? c) + (memq (syntax-e c) (current-variable-list)))] + [(s it? sub?) + (let ([sc (syntax-e c)]) + (let ([s (cond + [(syntax-property c 'display-string) => values] + [(literal-syntax? sc) (iformat "~s" (literal-syntax-stx sc))] + [(var-id? sc) (iformat "~s" (var-id-sym sc))] + [(eq? sc #t) + (if (equal? (syntax-span c) 5) + "#true" + "#t")] + [(eq? sc #f) + (if (equal? (syntax-span c) 6) + "#false" + "#f")] + [(and (number? sc) + (inexact? sc)) + (define s (iformat "~s" sc)) + (if (= (string-length s) + (- (syntax-span c) 2)) + ;; There's no way to know whether the source used #i, + ;; but it should be ok to include it: + (string-append "#i" s) + s)] + [else (iformat "~s" sc)])]) + (if (and escapes? + (symbol? sc) + ((string-length s) . > . 1) + (char=? (string-ref s 0) #\_) + (not (or (identifier-label-binding c) + is-var?))) + (values (substring s 1) #t #f) + (values s #f #f))))]) + (let ([quote-depth (if (and expr? (identifier? c) (not (eq? qq-ellipses (syntax-e c)))) + (let ([quote-depth + (if (and (quote-depth . < . 2) + (memq (syntax-e c) '(unquote unquote-splicing))) + (to-unquoted expr? quote-depth out color? void) + quote-depth)]) + (to-quoted c expr? quote-depth out color? void)) + quote-depth)]) + (if (or (element? (syntax-e c)) + (delayed-element? (syntax-e c)) + (part-relative-element? (syntax-e c)) + (convertible? (syntax-e c))) + (out (syntax-e c) #f) + (out (if (and (identifier? c) + color? + (quote-depth . <= . 0) + (not (or it? is-var?))) + (if (pair? (identifier-label-binding c)) + (make-id-element c s defn?) + (let ([c (nonbreak-leading-hyphens s)]) + (if defn? + (make-element symbol-def-color c) + c))) + (literalize-spaces s #t)) + (cond + [(positive? quote-depth) value-color] + [(let ([v (syntax-e c)]) + (or (number? v) + (string? v) + (bytes? v) + (char? v) + (regexp? v) + (byte-regexp? v) + (boolean? v) + (extflonum? v))) + value-color] + [(identifier? c) + (cond + [is-var? + variable-color] + [(and (identifier? c) + (memq (syntax-e c) (current-keyword-list))) + keyword-color] + [(and (identifier? c) + (memq (syntax-e c) (current-meta-list))) + meta-color] + [it? variable-color] + [else symbol-color])] + [else paren-color]) + (string-length s))))))) + +(define omitable (make-style #f '(omitable))) + +(define (gen-typeset c multi-line? prefix1 prefix suffix color? expr? escapes? defn? elem-wrap) + (let* ([c (syntax-ize c 0 #:expr? expr?)] + [content null] + [docs null] + [first (if escapes? + (syntax-case c (code:line) + [(code:line e . rest) #'e] + [(code:line . rest) #'rest] + [else c]) + c)] + [init-col (or (syntax-column first) 0)] + [src-col init-col] + [inc-src-col (lambda () (set! src-col (add1 src-col)))] + [dest-col 0] + [highlight? #f] + [col-map (make-hash)] + [next-col-map (make-hash)] + [line (or (syntax-line first) 0)]) + (define (finish-line!) + (when multi-line? + (set! docs (cons (make-paragraph omitable + (if (null? content) + (list (hspace 1)) + (reverse content))) + docs)) + (set! content null))) + (define out + (case-lambda + [(v cls) + (out v cls (let sz-loop ([v v]) + (cond + [(string? v) (string-length v)] + [(list? v) (for/fold ([s 0]) ([v (in-list v)]) (+ s (sz-loop v)))] + [(sized-element? v) (sized-element-length v)] + [(element? v) + (sz-loop (element-content v))] + [(delayed-element? v) + (content-width v)] + [(part-relative-element? v) + (content-width v)] + [(spaces? v) + (+ (sz-loop (car (element-content v))) + (spaces-cnt v) + (sz-loop (caddr (element-content v))))] + [else 1])))] + [(v cls len) + (unless (equal? v "") + (cond + [(spaces? v) + (out (car (element-content v)) cls 0) + (out (cadr (element-content v)) #f 0) + (out (caddr (element-content v)) cls len)] + [(equal? v "\n") + (if multi-line? + (begin + (finish-line!) + (out prefix cls)) + (out " " cls))] + [else + (set! content (cons (elem-wrap + ((if highlight? + (lambda (c) + (make-element highlight? c)) + values) + (if (and color? cls) + (make-element/cache cls v) + v))) + content)) + (set! dest-col (+ dest-col len))]))])) + (define advance + (case-lambda + [(c init-line! srcless-step delta) + (let ([c (+ delta (or (syntax-column c) + (if srcless-step + (+ src-col srcless-step) + 0)))] + [l (syntax-line c)]) + (let ([new-line? (and l (l . > . line))]) + (when new-line? + (for ([i (in-range (- l line))]) + (out "\n" #f)) + (set! line l) + (set! col-map next-col-map) + (set! next-col-map (make-hash)) + (init-line!)) + (let ([d-col (let ([def-val (+ dest-col (- c src-col))]) + (if new-line? + (hash-ref col-map c def-val) + def-val))]) + (let ([amt (- d-col dest-col)]) + (when (positive? amt) + (let ([old-dest-col dest-col]) + (out (if (and (= 1 amt) (not multi-line?)) + line-breakable-space ; allows a line break to replace the space + (hspace amt)) + #f) + (set! dest-col (+ old-dest-col amt)))))) + (set! src-col c) + (hash-set! next-col-map src-col dest-col)))] + [(c init-line! srcless-step) (advance c init-line! srcless-step 0)] + [(c init-line!) (advance c init-line! #f 0)])) + (define (for-each/i f l v) + (unless (null? l) + (f (car l) v) + (for-each/i f (cdr l) 1))) + (define (convert-infix c quote-depth expr?) + (let ([l (syntax->list c)]) + (and l + ((length l) . >= . 3) + ((or (syntax-position (car l)) -inf.0) + . > . + (or (syntax-position (cadr l)) +inf.0)) + (let ([a (car l)]) + (let loop ([l (cdr l)] + [prev null]) + (cond + [(null? l) #f] ; couldn't unwind + [else (let ([p2 (syntax-position (car l))]) + (if (and p2 + (p2 . > . (syntax-position a))) + (datum->syntax c + (append + (reverse prev) + (list + (datum->syntax + a + (let ([val? (positive? quote-depth)]) + (make-sized-element + (if val? value-color #f) + (list + (make-element/cache (if val? value-color paren-color) '". ") + (typeset a #f "" "" "" (not val?) expr? escapes? defn? elem-wrap) + (make-element/cache (if val? value-color paren-color) '" .")) + (+ (syntax-span a) 4))) + (list (syntax-source a) + (syntax-line a) + (- (syntax-column a) 2) + (- (syntax-position a) 2) + (+ (syntax-span a) 4)) + a)) + l) + c + c) + (loop (cdr l) + (cons (car l) prev))))])))))) + (define (no-fancy-chars s) + (cond + [(eq? s 'rsquo) "'"] + [else s])) + (define (loop init-line! quote-depth expr? no-cons?) + (lambda (c srcless-step) + (define (lloop quote-depth l) + (let inner-lloop ([first-element? #t] + [l l] + [first-expr? (and expr? + (or (zero? quote-depth) + (not (struct-proxy? (syntax-e c)))) + (not no-cons?))] + [dotted? #f] + [srcless-step #f]) + (define (print-dot-separator l) + (unless (and expr? (zero? quote-depth)) + (advance l init-line! (and srcless-step (+ srcless-step 3)) -2) + (out ". " (if (positive? quote-depth) value-color paren-color)) + (set! src-col (+ src-col 3))) + (hash-set! next-col-map src-col dest-col)) + (cond + [(let ([el (if (syntax? l) (syntax-e l) l)]) + (and (pair? el) + (eq? (if (syntax? (car el)) + (syntax-e (car el)) + (car el)) + 'code:hilite))) + (define l-stx + (if (syntax? l) + l + (datum->syntax #f l (list #f #f #f #f 0)))) + (print-dot-separator l-stx) + ((loop init-line! quote-depth first-expr? #f) l-stx (if (and expr? (zero? quote-depth)) + srcless-step + #f))] + [(and (syntax? l) + (pair? (syntax-e l)) + (not dotted?) + (not (and (memq (syntax-e (car (syntax-e l))) + '(quote unquote syntax unsyntax quasiquote quasiunsyntax)) + (let ([v (syntax->list l)]) + (and v (= 2 (length v)))) + (or (not expr?) + (quote-depth . > . 1) + (not (memq (syntax-e (car (syntax-e l))) + '(unquote unquote-splicing))))))) + (if first-element? + (inner-lloop #f (syntax-e l) first-expr? #f srcless-step) + (begin + (print-dot-separator l) + ((loop init-line! quote-depth first-expr? #f) l srcless-step)))] + [(and (or (null? l) + (and (syntax? l) + (null? (syntax-e l))))) + (void)] + [(and (pair? l) (not dotted?)) + ((loop init-line! quote-depth first-expr? #f) (car l) srcless-step) + (inner-lloop #f (cdr l) expr? #f 1)] + [(forced-pair? l) + ((loop init-line! quote-depth first-expr? #f) (forced-pair-car l) srcless-step) + (inner-lloop #f (forced-pair-cdr l) expr? #t 1)] + [(mpair? l) + ((loop init-line! quote-depth first-expr? #f) (mcar l) srcless-step) + (inner-lloop #f (mcdr l) expr? #t 1)] + [else + (print-dot-separator l) + ((loop init-line! quote-depth first-expr? #f) l (if (and expr? (zero? quote-depth)) + srcless-step + #f))]))) + (cond + [(and escapes? (eq? 'code:blank (syntax-e c))) + (advance c init-line! srcless-step)] + [(and escapes? + (pair? (syntax-e c)) + (eq? (syntax-e (car (syntax-e c))) 'code:comment)) + (let ([l (syntax->list c)]) + (unless (and l (= 2 (length l))) + (raise-syntax-error + #f + "does not have a single sub-form" + c))) + (advance c init-line! srcless-step) + (out ";" comment-color) + ;(out 'nbsp comment-color) + (let ([v (syntax->datum (cadr (syntax->list c)))]) + (if (paragraph? v) + (map (lambda (v) + (let ([v (no-fancy-chars v)]) + (if (or (string? v) (symbol? v)) + (out v comment-color) + (out v #f)))) + (paragraph-content v)) + (out (no-fancy-chars v) comment-color)))] + [(and escapes? + (pair? (syntax-e c)) + (eq? (syntax-e (car (syntax-e c))) 'code:contract)) + (advance c init-line! srcless-step) + (out "; " comment-color) + (let* ([l (cdr (syntax->list c))] + [s-col (or (syntax-column (car l)) src-col)]) + (set! src-col s-col) + (for-each/i (loop (lambda () + (set! src-col s-col) + (set! dest-col 0) + (out "; " comment-color)) + 0 + expr? + #f) + l + #f))] + [(and escapes? + (pair? (syntax-e c)) + (eq? (syntax-e (car (syntax-e c))) 'code:line)) + (lloop quote-depth + (cdr (syntax-e c)))] + [(and escapes? + (pair? (syntax-e c)) + (eq? (syntax-e (car (syntax-e c))) 'code:hilite)) + (let ([l (syntax->list c)] + [h? highlight?]) + (unless (and l (or (= 2 (length l)) (= 3 (length l)))) + (error "bad code:hilite: ~.s" (syntax->datum c))) + + (advance c init-line! srcless-step) + (set! src-col (syntax-column (cadr l))) + (hash-set! next-col-map src-col dest-col) + + (set! highlight? (if (= 3 (length l)) + (let ([the-style (syntax-e (caddr l))]) + (if (syntax? the-style) + (syntax->datum the-style) + the-style)) + highlighted-color)) + ((loop init-line! quote-depth expr? #f) (cadr l) #f) + (set! highlight? h?) + (unless (= (syntax-span c) 0) + (set! src-col (add1 src-col))))] + [(and escapes? + (pair? (syntax-e c)) + (eq? (syntax-e (car (syntax-e c))) 'code:quote)) + (advance c init-line! srcless-step) + (let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) + (out "(" (if (positive? quote-depth) value-color paren-color)) + (set! src-col (+ src-col 1)) + (hash-set! next-col-map src-col dest-col) + ((loop init-line! quote-depth expr? #f) + (datum->syntax #'here 'quote (car (syntax-e c))) + #f) + (for-each/i (loop init-line! (add1 quote-depth) expr? #f) + (cdr (syntax->list c)) + 1) + (out ")" (if (positive? quote-depth) value-color paren-color)) + (set! src-col (+ src-col 1)) + #; + (hash-set! next-col-map src-col dest-col))] + [(and (pair? (syntax-e c)) + (memq (syntax-e (car (syntax-e c))) + '(quote quasiquote unquote unquote-splicing + quasisyntax syntax unsyntax unsyntax-splicing)) + (let ([v (syntax->list c)]) + (and v (= 2 (length v)))) + (or (not expr?) + (positive? quote-depth) + (quotable? c))) + (advance c init-line! srcless-step) + (let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) + (let-values ([(str quote-delta) + (case (syntax-e (car (syntax-e c))) + [(quote) (values "'" +inf.0)] + [(unquote) (values "," -1)] + [(unquote-splicing) (values ",@" -1)] + [(quasiquote) (values "`" +1)] + [(syntax) (values "#'" 0)] + [(quasisyntax) (values "#`" 0)] + [(unsyntax) (values "#," 0)] + [(unsyntax-splicing) (values "#,@" 0)])]) + (out str (if (positive? (+ quote-depth quote-delta)) + value-color + reader-color)) + (let ([i (cadr (syntax->list c))]) + (set! src-col (or (syntax-column i) src-col)) + (hash-set! next-col-map src-col dest-col) + ((loop init-line! (max 0 (+ quote-depth quote-delta)) expr? #f) i #f))))] + [(and (pair? (syntax-e c)) + (or (not expr?) + (positive? quote-depth) + (quotable? c)) + (convert-infix c quote-depth expr?)) + => (lambda (converted) + ((loop init-line! quote-depth expr? #f) converted srcless-step))] + [(or (pair? (syntax-e c)) + (mpair? (syntax-e c)) + (forced-pair? (syntax-e c)) + (null? (syntax-e c)) + (vector? (syntax-e c)) + (and (struct? (syntax-e c)) + (prefab-struct-key (syntax-e c))) + (struct-proxy? (syntax-e c))) + (let* ([sh (or (syntax-property c 'paren-shape) + (if (and (mpair? (syntax-e c)) + (not (and expr? (zero? quote-depth)))) + #\{ + #\())] + [quote-depth (if (and (not expr?) + (zero? quote-depth) + (or (vector? (syntax-e c)) + (struct? (syntax-e c)))) + 1 + quote-depth)] + [p-color (if (positive? quote-depth) + value-color + (if (eq? sh #\?) + opt-color + paren-color))]) + (advance c init-line! srcless-step) + (let ([quote-depth (if (struct-proxy? (syntax-e c)) + quote-depth + (to-quoted c expr? quote-depth out color? inc-src-col))]) + (when (and expr? (zero? quote-depth)) + (out "(" p-color) + (unless no-cons? + (out (let ([s (cond + [(pair? (syntax-e c)) + (if (syntax->list c) + "list" + (if (let ([d (cdr (syntax-e c))]) + (or (pair? d) + (and (syntax? d) + (pair? (syntax-e d))))) + "list*" + "cons"))] + [(vector? (syntax-e c)) "vector"] + [(mpair? (syntax-e c)) "mcons"] + [else (iformat "~a" + (if (struct-proxy? (syntax-e c)) + (syntax-e (struct-proxy-name (syntax-e c))) + (object-name (syntax-e c))))])]) + (set! src-col (+ src-col (if (struct-proxy? (syntax-e c)) + 1 + (string-length s)))) + s) + symbol-color) + (unless (and (struct-proxy? (syntax-e c)) + (null? (struct-proxy-content (syntax-e c)))) + (out " " #f)))) + (when (vector? (syntax-e c)) + (unless (and expr? (zero? quote-depth)) + (let ([vec (syntax-e c)]) + (out "#" p-color) + (if (zero? (vector-length vec)) + (set! src-col (+ src-col (- (syntax-span c) 2))) + (set! src-col (+ src-col (- (syntax-column (vector-ref vec 0)) + (syntax-column c) + 1))))))) + (when (struct? (syntax-e c)) + (unless (and expr? (zero? quote-depth)) + (out "#s" p-color) + (set! src-col (+ src-col 2)))) + (unless (and expr? (zero? quote-depth)) + (out (case sh + [(#\[ #\?) "["] + [(#\{) "{"] + [else "("]) + p-color)) + (set! src-col (+ src-col 1)) + (hash-set! next-col-map src-col dest-col) + (lloop quote-depth + (cond + [(vector? (syntax-e c)) + (vector->short-list (syntax-e c) syntax-e)] + [(struct? (syntax-e c)) + (let ([l (vector->list (struct->vector (syntax-e c)))]) + ;; Need to build key datum, syntax-ize it internally, and + ;; set the overall width to fit right: + (if (and expr? (zero? quote-depth)) + (cdr l) + (cons (let ([key (syntax-ize (prefab-struct-key (syntax-e c)) + (+ 3 (or (syntax-column c) 0)) + (or (syntax-line c) 1))] + [end (if (pair? (cdr l)) + (and (equal? (syntax-line c) (syntax-line (cadr l))) + (syntax-column (cadr l))) + (and (syntax-column c) + (+ (syntax-column c) (syntax-span c))))]) + (if end + (datum->syntax #f + (syntax-e key) + (vector #f (syntax-line key) + (syntax-column key) + (syntax-position key) + (max 1 (- end 1 (syntax-column key))))) + end)) + (cdr l))))] + [(struct-proxy? (syntax-e c)) + (struct-proxy-content (syntax-e c))] + [(forced-pair? (syntax-e c)) + (syntax-e c)] + [(mpair? (syntax-e c)) + (syntax-e c)] + [else c])) + (out (case sh + [(#\[ #\?) "]"] + [(#\{) "}"] + [else ")"]) + p-color) + (set! src-col (+ src-col 1))))] + [(box? (syntax-e c)) + (advance c init-line! srcless-step) + (let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) + (if (and expr? (zero? quote-depth)) + (begin + (out "(" paren-color) + (out "box" symbol-color) + (out " " #f) + (set! src-col (+ src-col 5))) + (begin + (out "#&" value-color) + (set! src-col (+ src-col 2)))) + (hash-set! next-col-map src-col dest-col) + ((loop init-line! (if expr? quote-depth +inf.0) expr? #f) (unbox (syntax-e c)) #f) + (when (and expr? (zero? quote-depth)) + (out ")" paren-color)))] + [(hash? (syntax-e c)) + (advance c init-line! srcless-step) + (let ([equal-table? (hash-equal? (syntax-e c))] + [eqv-table? (hash-eqv? (syntax-e c))] + [quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) + (unless (and expr? (zero? quote-depth)) + (out (if equal-table? + "#hash" + (if eqv-table? + "#hasheqv" + "#hasheq")) + value-color)) + (let ([delta (+ 5 (if equal-table? 0 (if eqv-table? 3 2)) + (if (and expr? (zero? quote-depth)) 1 0))] + [orig-col src-col]) + (set! src-col (+ src-col delta)) + (hash-set! next-col-map src-col dest-col) + ((loop init-line! (if expr? quote-depth +inf.0) expr? (and expr? (zero? quote-depth))) + (let*-values ([(l) (sort (hash-map (syntax-e c) cons) + (lambda (a b) + (< (or (syntax-position (cdr a)) -inf.0) + (or (syntax-position (cdr b)) -inf.0))))] + [(sep cap) (if (and expr? (zero? quote-depth)) + (values 1 0) + (values 3 1))] + [(col0) (+ (syntax-column c) delta cap 1)] + [(l2 pos line) (for/fold ([l2 null][col col0][line (syntax-line c)]) + ([p (in-list l)]) + (let* ([tentative (syntax-ize (car p) 0 + #:expr? (and expr? (zero? quote-depth)))] + [width (syntax-span tentative)] + [col (if (= line (syntax-line (cdr p))) + col + col0)]) + (let ([key + (let ([e (syntax-ize (car p) + (max 0 (- (syntax-column (cdr p)) + width + sep)) + (syntax-line (cdr p)) + #:expr? (and expr? (zero? quote-depth)))]) + (if ((syntax-column e) . <= . col) + e + (datum->syntax #f + (syntax-e e) + (vector (syntax-source e) + (syntax-line e) + col + (syntax-position e) + (+ (syntax-span e) (- (syntax-column e) col))))))]) + (let ([elem + (datum->syntax + #f + (make-forced-pair key (cdr p)) + (vector 'here + (syntax-line (cdr p)) + (max 0 (- (syntax-column key) cap)) + (max 1 (- (syntax-position key) cap)) + (+ (syntax-span (cdr p)) (syntax-span key) sep cap cap)))]) + (values (cons elem l2) + (+ (syntax-column elem) (syntax-span elem) 2) + (syntax-line elem))))))]) + (if (and expr? (zero? quote-depth)) + ;; constructed: + (let ([l (apply append + (map (lambda (p) + (let ([p (syntax-e p)]) + (list (forced-pair-car p) + (forced-pair-cdr p)))) + (reverse l2)))]) + (datum->syntax + #f + (cons (let ([s (if equal-table? + 'hash + (if eqv-table? + 'hasheqv + 'hasheq))]) + (datum->syntax #f + s + (vector (syntax-source c) + (syntax-line c) + (+ (syntax-column c) 1) + (+ (syntax-position c) 1) + (string-length (symbol->string s))))) + l) + c)) + ;; quoted: + (datum->syntax #f (reverse l2) (vector (syntax-source c) + (syntax-line c) + (+ (syntax-column c) delta) + (+ (syntax-position c) delta) + (max 1 (- (syntax-span c) delta)))))) + #f) + (set! src-col (+ orig-col (syntax-span c)))))] + [(graph-reference? (syntax-e c)) + (advance c init-line! srcless-step) + (out (iformat "#~a#" (unbox (graph-reference-bx (syntax-e c)))) + (if (positive? quote-depth) + value-color + paren-color)) + (set! src-col (+ src-col (syntax-span c)))] + [(graph-defn? (syntax-e c)) + (advance c init-line! srcless-step) + (let ([bx (graph-defn-bx (syntax-e c))]) + (out (iformat "#~a=" (unbox bx)) + (if (positive? quote-depth) + value-color + paren-color)) + (set! src-col (+ src-col 3)) + ((loop init-line! quote-depth expr? #f) (graph-defn-r (syntax-e c)) #f))] + [(and (keyword? (syntax-e c)) expr?) + (advance c init-line! srcless-step) + (let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) + (typeset-atom c out color? quote-depth expr? escapes? defn?) + (set! src-col (+ src-col (or (syntax-span c) 1))))] + [else + (advance c init-line! srcless-step) + (typeset-atom c out color? quote-depth expr? escapes? defn?) + (set! src-col (+ src-col (or (syntax-span c) 1))) + #; + (hash-set! next-col-map src-col dest-col)]))) + (out prefix1 #f) + (set! dest-col 0) + (hash-set! next-col-map init-col dest-col) + ((loop (lambda () (set! src-col init-col) (set! dest-col 0)) 0 expr? #f) c #f) + (if (list? suffix) + (map (lambda (sfx) + (finish-line!) + (out sfx #f)) + suffix) + (out suffix #f)) + (unless (null? content) + (finish-line!)) + (if multi-line? + (if (= 1 (length docs)) + (car docs) + (make-table block-color (map list (reverse docs)))) + (make-sized-element #f (reverse content) dest-col)))) + +(define (typeset c multi-line? prefix1 prefix suffix color? expr? escapes? defn? elem-wrap) + (let* ([c (syntax-ize c 0 #:expr? expr?)] + [s (syntax-e c)]) + (if (or multi-line? + (and escapes? (eq? 'code:blank s)) + (pair? s) + (mpair? s) + (vector? s) + (struct? s) + (box? s) + (null? s) + (hash? s) + (graph-defn? s) + (graph-reference? s) + (struct-proxy? s) + (and expr? (or (identifier? c) + (keyword? (syntax-e c))))) + (gen-typeset c multi-line? prefix1 prefix suffix color? expr? escapes? defn? elem-wrap) + (typeset-atom c + (letrec ([mk + (case-lambda + [(elem color) + (mk elem color (or (syntax-span c) 1))] + [(elem color len) + (elem-wrap + (if (and (string? elem) + (= len (string-length elem))) + (make-element/cache (and color? color) elem) + (make-sized-element (and color? color) elem len)))])]) + mk) + color? 0 expr? escapes? defn?)))) + +(define (to-element c + #:expr? [expr? #f] + #:escapes? [escapes? #t] + #:defn? [defn? #f]) + (typeset c #f "" "" "" #t expr? escapes? defn? values)) + +(define (to-element/no-color c + #:expr? [expr? #f] + #:escapes? [escapes? #t]) + (typeset c #f "" "" "" #f expr? escapes? #f values)) + +(define (to-paragraph c + #:expr? [expr? #f] + #:escapes? [escapes? #t] + #:color? [color? #t] + #:wrap-elem [elem-wrap (lambda (e) e)]) + (typeset c #t "" "" "" color? expr? escapes? #f elem-wrap)) + +(define ((to-paragraph/prefix pfx1 pfx sfx) c + #:expr? [expr? #f] + #:escapes? [escapes? #t] + #:color? [color? #t] + #:wrap-elem [elem-wrap (lambda (e) e)]) + (typeset c #t pfx1 pfx sfx color? expr? escapes? #f elem-wrap)) + +(begin-for-syntax + (define-struct variable-id (sym) + #:omit-define-syntaxes + #:property prop:procedure (lambda (self stx) + (raise-syntax-error + #f + (string-append + "misuse of an identifier (not in `racket', etc.) that is" + " bound as a code-typesetting variable") + stx))) + (define-struct element-id-transformer (proc) + #:omit-define-syntaxes + #:property prop:procedure (lambda (self stx) + (raise-syntax-error + #f + (string-append + "misuse of an identifier (not in `racket', etc.) that is" + " bound as an code-typesetting element transformer") + stx)))) + +(begin-for-syntax + (require mutable-match-lambda) + + (define mutable-match-element-id-transformer + (make-mutable-match-lambda/infer-name)) + + (define (try-mutable-match-element-id-transformer . vs) + (apply (apply make-mutable-match-lambda + (append (mutable-match-lambda-procedure-procs + mutable-match-element-id-transformer) + (list (clause->proc #:match-lambda [_ #f])))) + vs)) + + (provide mutable-match-element-id-transformer)) + +(define-syntax (define-code stx) + (syntax-case stx () + [(the-id code typeset-code uncode d->s stx-prop) + (syntax/loc stx + (define-syntax (code stx) + (define (wrap-loc v ctx e) + `(,#'d->s ,ctx + ,e + #(code + ,(syntax-line v) + ,(syntax-column v) + ,(syntax-position v) + ,(syntax-span v)))) + (define (stx->loc-s-expr/esc v uncode-id) + (define (stx->loc-s-expr v) + (let ([slv (and (identifier? v) + (syntax-local-value v (lambda () #f)))]) + (cond + [(and (syntax? v) (syntax-property v 'scribble-render)) + => (λ (renderer) + (wrap-loc v #f (renderer v)))] + [(and (syntax? v) (syntax-property v 'scribble-render-as)) + => (λ (renderer) + (stx->loc-s-expr + (with-syntax ([splice + (renderer v + (quote-syntax the-id) + (quote-syntax code) + (quote-syntax typeset-code) + (quote-syntax uncode) + (quote-syntax d->s) + (quote-syntax stx-prop))]) + (syntax/loc #'splice + (code:line . splice)))))] + [(variable-id? slv) + (wrap-loc v #f `(,#'make-var-id ',(variable-id-sym slv)))] + [(element-id-transformer? slv) + (wrap-loc v #f ((element-id-transformer-proc slv) v))] + [(try-mutable-match-element-id-transformer v) + => (λ (transformed) + (wrap-loc v #f transformed))] + [(syntax? v) + (let ([mk (wrap-loc + v + `(quote-syntax ,(datum->syntax v 'defcode)) + (syntax-case v () + [(esc e) + (and (identifier? #'esc) + (free-identifier=? #'esc uncode-id)) + #'e] + [else (stx->loc-s-expr (syntax-e v))]))]) + (let ([prop (syntax-property v 'paren-shape)]) + (if prop + `(,#'stx-prop ,mk 'paren-shape ,prop) + mk)))] + [(null? v) 'null] + [(list? v) `(list . ,(map stx->loc-s-expr v))] + [(pair? v) `(cons ,(stx->loc-s-expr (car v)) + ,(stx->loc-s-expr (cdr v)))] + [(vector? v) `(vector ,@(map + stx->loc-s-expr + (vector->list v)))] + [(and (struct? v) (prefab-struct-key v)) + `(make-prefab-struct (quote ,(prefab-struct-key v)) + ,@(map + stx->loc-s-expr + (cdr (vector->list (struct->vector v)))))] + [(box? v) `(box ,(stx->loc-s-expr (unbox v)))] + [(hash? v) `(,(cond + [(hash-eq? v) 'make-immutable-hasheq] + [(hash-eqv? v) 'make-immutable-hasheqv] + [else 'make-immutable-hash]) + (list + ,@(hash-map + v + (lambda (k v) + `(cons (quote ,k) + ,(stx->loc-s-expr v))))))] + [else `(quote ,v)]))) + (stx->loc-s-expr v)) + (define (cvt s uncode-id) + (datum->syntax #'here (stx->loc-s-expr/esc s uncode-id) #f)) + (if (eq? (syntax-local-context) 'expression) + (syntax-case stx () + [(_ #:escape uncode-id expr) #`(typeset-code #,(cvt #'expr #'uncode-id))] + [(_ expr) #`(typeset-code #,(cvt #'expr #'uncode))] + [(_ #:escape uncode-id expr (... ...)) + #`(typeset-code #,(cvt #'(code:line expr (... ...)) #'uncode-id))] + [(_ expr (... ...)) + #`(typeset-code #,(cvt #'(code:line expr (... ...)) #'uncode))]) + (quasisyntax/loc stx + (#%expression #,stx)))))] + [(_ code typeset-code uncode d->s) + #'(define-code code typeset-code uncode d->s syntax-property)] + [(_ code typeset-code uncode) + #'(define-code code typeset-code uncode datum->syntax syntax-property)] + [(_ code typeset-code) #'(define-code code typeset-code unsyntax)])) + + +(define syntax-ize-hook (make-parameter (lambda (v col) #f))) + +(define (vector->short-list v extract) + (vector->list v) + #; + (let ([l (vector->list v)]) + (reverse (list-tail + (reverse l) + (- (vector-length v) + (let loop ([i (sub1 (vector-length v))]) + (cond + [(zero? i) 1] + [(eq? (extract (vector-ref v i)) + (extract (vector-ref v (sub1 i)))) + (loop (sub1 i))] + [else (add1 i)]))))))) + +(define (short-list->vector v l) + (list->vector + (let ([n (length l)]) + (if (n . < . (vector-length v)) + (reverse (let loop ([r (reverse l)][i (- (vector-length v) n)]) + (if (zero? i) + r + (loop (cons (car r) r) (sub1 i))))) + l)))) + +(define-struct var-id (sym)) +(define-struct shaped-parens (val shape)) +(define-struct long-boolean (val)) +(define-struct just-context (val ctx)) +(define-struct alternate-display (id string)) +(define-struct literal-syntax (stx)) +(define-struct struct-proxy (name content)) + +(define-struct graph-reference (bx)) +(define-struct graph-defn (r bx)) + +(define (syntax-ize v col [line 1] #:expr? [expr? #f]) + (do-syntax-ize v col line (box #hasheq()) #f (and expr? 0) #f)) + +(define (graph-count ht graph?) + (and graph? + (let ([n (hash-ref (unbox ht) '#%graph-count 0)]) + (set-box! ht (hash-set (unbox ht) '#%graph-count (add1 n))) + n))) + +(define-struct forced-pair (car cdr)) + +(define (quotable? v) + (define graph (make-hasheq)) + (let quotable? ([v v]) + (if (hash-ref graph v #f) + #t + (begin + (hash-set! graph v #t) + (cond + [(syntax? v) (quotable? (syntax-e v))] + [(pair? v) (and (quotable? (car v)) + (quotable? (cdr v)))] + [(vector? v) (andmap quotable? (vector->list v))] + [(hash? v) (for/and ([(k v) (in-hash v)]) + (and (quotable? k) + (quotable? v)))] + [(box? v) (quotable? (unbox v))] + [(and (struct? v) + (prefab-struct-key v)) + (andmap quotable? (vector->list (struct->vector v)))] + [(struct? v) (if (custom-write? v) + (case (or (and (custom-print-quotable? v) + (custom-print-quotable-accessor v)) + 'self) + [(self always) #t] + [(never) #f] + [(maybe) + (andmap quotable? (vector->list (struct->vector v)))]) + #f)] + [(struct-proxy? v) #f] + [(mpair? v) #f] + [else #t]))))) + +(define (do-syntax-ize v col line ht graph? qq no-cons?) + (cond + [((syntax-ize-hook) v col) + => (lambda (r) r)] + [(shaped-parens? v) + (syntax-property (do-syntax-ize (shaped-parens-val v) col line ht #f qq #f) + 'paren-shape + (shaped-parens-shape v))] + [(long-boolean? v) + (datum->syntax #f + (and (long-boolean-val v) #t) + (vector #f line col (+ 1 col) (if (long-boolean-val v) 5 6)))] + [(just-context? v) + (let ([s (do-syntax-ize (just-context-val v) col line ht #f qq #f)]) + (datum->syntax (just-context-ctx v) + (syntax-e s) + s + s + (just-context-ctx v)))] + [(alternate-display? v) + (let ([s (do-syntax-ize (alternate-display-id v) col line ht #f qq #f)]) + (syntax-property s + 'display-string + (alternate-display-string v)))] + [(hash-ref (unbox ht) v #f) + => (lambda (m) + (unless (unbox m) + (set-box! m #t)) + (datum->syntax #f + (make-graph-reference m) + (vector #f line col (+ 1 col) 1)))] + [(and qq + (zero? qq) + (or (pair? v) + (forced-pair? v) + (vector? v) + (hash? v) + (box? v) + (and (struct? v) + (prefab-struct-key v))) + (quotable? v) + (not no-cons?)) + ;; Add a quote: + (let ([l (do-syntax-ize v (add1 col) line ht #f 1 #f)]) + (datum->syntax #f + (syntax-e l) + (vector (syntax-source l) + (syntax-line l) + (sub1 (syntax-column l)) + (max 0 (sub1 (syntax-position l))) + (add1 (syntax-span l)))))] + [(and (list? v) + (pair? v) + (or (not qq) + (positive? qq) + (quotable? v)) + (let ([s (let ([s (car v)]) + (if (just-context? s) + (just-context-val s) + s))]) + (memq s '(quote unquote unquote-splicing))) + (not no-cons?)) + => (lambda (s) + (let* ([delta (if (and qq (zero? qq)) + 1 + 0)] + [c (do-syntax-ize (cadr v) (+ col delta) line ht #f qq #f)]) + (datum->syntax #f + (list (do-syntax-ize (car v) col line ht #f qq #f) + c) + (vector #f line col (+ 1 col) + (+ delta + (syntax-span c))))))] + [(or (list? v) + (vector? v) + (and (struct? v) + (or (and qq + ;; Watch out for partially transparent subtypes of `element' + ;; or convertible values: + (not (convertible? v)) + (not (element? v))) + (prefab-struct-key v)))) + (let ([orig-ht (unbox ht)] + [graph-box (box (graph-count ht graph?))]) + (set-box! ht (hash-set (unbox ht) v graph-box)) + (let* ([graph-sz (if graph? + (+ 2 (string-length (format "~a" (unbox graph-box)))) + 0)] + [vec-sz (cond + [(vector? v) + (if (and qq (zero? qq)) 0 1)] + [(struct? v) + (if (and (prefab-struct-key v) + (or (not qq) (positive? qq))) + 2 + 0)] + [else 0])] + [delta (if (and qq (zero? qq)) + (cond + [(vector? v) 8] ; `(vector ' + [(struct? v) 1] ; '(' + [no-cons? 1] ; '(' + [else 6]) ; `(list ' + 1)] + [r (let ([l (let loop ([col (+ col delta vec-sz graph-sz)] + [v (cond + [(vector? v) + (vector->short-list v values)] + [(struct? v) + (cons (let ([pf (prefab-struct-key v)]) + (if pf + (prefab-struct-key v) + (object-name v))) + (cdr (vector->list (struct->vector v qq-ellipses))))] + [else v])]) + (if (null? v) + null + (let ([i (do-syntax-ize (car v) col line ht #f qq #f)]) + (cons i + (loop (+ col 1 (syntax-span i)) (cdr v))))))]) + (datum->syntax #f + (cond + [(vector? v) (short-list->vector v l)] + [(struct? v) + (let ([pf (prefab-struct-key v)]) + (if pf + (apply make-prefab-struct (prefab-struct-key v) (cdr l)) + (make-struct-proxy (car l) (cdr l))))] + [else l]) + (vector #f line + (+ graph-sz col) + (+ 1 graph-sz col) + (+ 1 + vec-sz + delta + (if (zero? (length l)) + 0 + (sub1 (length l))) + (apply + (map syntax-span l))))))]) + (unless graph? + (set-box! ht (hash-set (unbox ht) v #f))) + (cond + [graph? (datum->syntax #f + (make-graph-defn r graph-box) + (vector #f (syntax-line r) + (- (syntax-column r) graph-sz) + (- (syntax-position r) graph-sz) + (+ (syntax-span r) graph-sz)))] + [(unbox graph-box) + ;; Go again, this time knowing that there will be a graph: + (set-box! ht orig-ht) + (do-syntax-ize v col line ht #t qq #f)] + [else r])))] + [(or (pair? v) + (mpair? v) + (forced-pair? v)) + (let ([carv (if (pair? v) (car v) (if (mpair? v) (mcar v) (forced-pair-car v)))] + [cdrv (if (pair? v) (cdr v) (if (mpair? v) (mcdr v) (forced-pair-cdr v)))] + [orig-ht (unbox ht)] + [graph-box (box (graph-count ht graph?))]) + (set-box! ht (hash-set (unbox ht) v graph-box)) + (let* ([delta (if (and qq (zero? qq) (not no-cons?)) + (if (mpair? v) + 7 ; "(mcons " + (if (or (list? cdrv) + (not (pair? cdrv))) + 6 ; "(cons " + 7)) ; "(list* " + 1)] + [inc (if graph? + (+ 2 (string-length (format "~a" (unbox graph-box)))) + 0)] + [a (do-syntax-ize carv (+ col delta inc) line ht #f qq #f)] + [sep (if (and (pair? v) + (pair? cdrv) + ;; FIXME: what if it turns out to be a graph reference? + (not (hash-ref (unbox ht) cdrv #f))) + 0 + (if (and qq (zero? qq)) + 1 + 3))] + [b (do-syntax-ize cdrv (+ col delta inc (syntax-span a) sep) line ht #f qq #t)]) + (let ([r (datum->syntax #f + (if (mpair? v) + (mcons a b) + (cons a b)) + (vector #f line (+ col inc) (+ delta col inc) + (+ 1 delta + (if (and qq (zero? qq)) 1 0) + sep (syntax-span a) (syntax-span b))))]) + (unless graph? + (set-box! ht (hash-set (unbox ht) v #f))) + (cond + [graph? (datum->syntax #f + (make-graph-defn r graph-box) + (vector #f line col (+ delta col) + (+ inc (syntax-span r))))] + [(unbox graph-box) + ;; Go again... + (set-box! ht orig-ht) + (do-syntax-ize v col line ht #t qq #f)] + [else r]))))] + [(box? v) + (let* ([delta (if (and qq (zero? qq)) + 5 ; "(box " + 2)] ; "#&" + [a (do-syntax-ize (unbox v) (+ col delta) line ht #f qq #f)]) + (datum->syntax #f + (box a) + (vector #f line col (+ 1 col) + (+ delta (if (and qq (zero? qq)) 1 0) (syntax-span a)))))] + [(hash? v) + (let* ([delta (cond + [(hash-eq? v) 7] + [(hash-eqv? v) 8] + [else 6])] + [undelta (if (and qq (zero? qq)) + (- delta 1) + 0)] + [pairs (if (and qq (zero? qq)) + (let ([ls (do-syntax-ize (apply append (hash-map v (lambda (k v) (list k v)))) + (+ col delta -1) line ht #f qq #t)]) + (datum->syntax + #f + (let loop ([l (syntax->list ls)]) + (if (null? l) + null + (cons (cons (car l) (cadr l)) (loop (cddr l))))) + ls)) + (do-syntax-ize (hash-map v make-forced-pair) (+ col delta) line ht #f qq #f))]) + (datum->syntax #f + ((cond + [(hash-eq? v) make-immutable-hasheq] + [(hash-eqv? v) make-immutable-hasheqv] + [else make-immutable-hash]) + (map (lambda (p) + (let ([p (syntax-e p)]) + (cons (syntax->datum (car p)) + (cdr p)))) + (syntax->list pairs))) + (vector (syntax-source pairs) + (syntax-line pairs) + (max 0 (- (syntax-column pairs) undelta)) + (max 1 (- (syntax-position pairs) undelta)) + (+ (syntax-span pairs) undelta))))] + [else + (datum->syntax #f v (vector #f line col (+ 1 col) 1))])) +\ No newline at end of file diff --git a/scribblings/scribble-enhanced-example.lp2.rkt b/scribblings/scribble-enhanced-example.lp2.rkt @@ -0,0 +1,64 @@ +#lang scribble/lp2 +@(require scribble-enhanced/doc) +@doc-lib-setup + +@title[#:style manual-doc-style]{Implementation of structures} + +@;Racket is distributed with implementations of many SRFIs, most of +@;which can be implemented as libraries. To import the bindings of SRFI +@;@math{n}, use +@; +@;@racketblock[ +@;(require @#,elem{@racketidfont{srfi/}@math{n}}) +@;] + +@section{A section} + +In section @secref{doc/example|foo} we present, blah blah. + +@subsection[#:tag "doc/example|foo"]{My subsection} + +@;Works only with HTML, as \class is not defined. TODO: define it. +@;@$${\frac{\href{//jsmaniac.github.io}{2x}}{\class{some-css-class}{x^2}}} + + +@(colorize (filled-ellipse 30 15) "blue") +@; Line comment + +Blah @math{n}, as described by M@._ Foo@.__ +@racketblock[ + (require @#,elem{@racketidfont{srfi/}@math{n}})] + +@(define to-insert 42) +@chunk[<scribble-enhanced-example.lp2.rkt-main-chunk> + ;(displayln #,to-insert) ;; Should work. + (provide some-ident) + <some-ident> + + (module* test racket + (require (submod "..")) + (require rackunit) + (check-equal? (some-ident) "foo"))] + +@CHUNK[<some-ident> + (define (some-ident) + (syntax-e #`#,"foo"))] + +@itemlist[ + @item{Item 1} + @item{Item 2}] + +It would be nice to be able to alter existing chunks, by inserting stuff later, +for example: + +@chunk[<c> + (define-syntax-rule (double x) + (+ x x))] + +But we would actually want: + +@chunk[<redef-c> + (define-syntax-rule (double x) -- should be greyed out + (let ((x-cache x)) + (+ x-cache x-cache))) -- everything except the changed bits should + -- be greyed out] diff --git a/scribblings/scribble-enhanced-template.lp2.rkt b/scribblings/scribble-enhanced-template.lp2.rkt @@ -0,0 +1,111 @@ +#lang scribble/lp2 +@; TODO: use hyper-literate language instead. +@(require scribble-enhanced/doc) +@doc-lib-setup + +@title[#:style manual-doc-style]{Life, the Universe and Everything.} + +@(table-of-contents) + +@section{Introduction} + +@chunk[<lue> + (define lue 42)] + +Here is a macro: + +@CHUNK[<scribble-macro-expansion> + (define-for-syntax mymacro-tmp + (syntax-rules () [(_ a b) (let ((b 1)) a)])) + (define-syntax (mymacro-stx stx) #`'#,(mymacro-tmp stx)) + (define-syntax mymacro mymacro-tmp)] + +We can use it like this: + +@chunk[<scribble-macro-expansion-example> + (mymacro (+ x 3) x)] + +@(begin + (require (for-syntax racket/base)) + (define-syntax (if<6.4 stx) + (syntax-case stx () + [(_ lt ge) + (if (or (regexp-match #px"^6(\\.[0123](\\..*|)|)$" (version)) + (regexp-match #px"^[123245]\\..*$" (version))) + #'lt + #'ge)])) + (define-syntax-rule (skip<6.4 . rest) (if<6.4 (begin) (begin . rest)))) + +@skip<6.4{ + Which expands to (requires Racket ≥ 6.4 and a bit of set-up boilerplate to have + the output in scribble, see + @url{http://lists.racket-lang.org/users/archive/2014-December/065175.html}): + @(begin + (require syntax/location scribble/example) + (define res-mod-name + (resolved-module-path-name + (module-path-index-resolve + (module-path-index-join '(submod ".." main) + (variable-reference->module-path-index + (#%variable-reference)))))) + (define evaluator (make-base-eval #:lang 'typed/racket)) + (evaluator + #`(begin + (require/typed racket/enter + [dynamic-enter! (->* (Module-Path) + (#:re-require-enter? Any) + Void)]) + (dynamic-require (cast '#,(cons 'submod res-mod-name) Module-Path) #f) + (dynamic-enter! (cast '#,(cons 'submod res-mod-name) Module-Path) + #:re-require-enter? #f)))) + + @examples[#:eval evaluator #:result-only + (mymacro-stx (+ x 3) x) + #;(begin + (require (for-syntax racket/pretty)) + (begin-for-syntax + (pretty-write + (syntax->datum + #'(mymacro-tmp (+ x 3) x)))))] + + The code above should show the expanded code, i.e:} + +@if<6.4[ + @list{With Racket ≥ 6.4, it is possible to automatically compute the expanded + code, and show it. The result would be:} + @list{}] + +@chunk[<expanded-code> + (let ((x 1)) (+ x 3))] + +@chunk[<test-foo> + (check-equal? lue 42)] + +@section{Conclusion} + +@chunk[<main-module> + (module main typed/racket + (require (for-syntax syntax/parse + racket/syntax + #;phc-toolkit/untyped) + #;phc-toolkit/untyped) + (provide lue) + + <lue> + <scribble-macro-expansion>)] + +@chunk[<module-test> + (module* test typed/racket + (require (submod "..") + typed/rackunit) + + <test-foo>)] + +@chunk[<*> + (begin + <main-module> + + (require 'main) + (provide (all-from-out 'main)) + + <module-test>)] +\ No newline at end of file diff --git a/scribblings/scribble-enhanced.scrbl b/scribblings/scribble-enhanced.scrbl @@ -0,0 +1,218 @@ +#lang scribble/manual +@require[@for-label[(except-in scribble-enhanced define-code) + racket/base + (only-in scribble/racket define-code) + (only-in syntax/stx stx-list?)] + scribble-enhanced] + +@title{Scribble Enhanced} +@author[@author+email["Suzanne Soy" "racket@suzanne.soy"]] + +@defmodule[scribble-enhanced] + +@section{@racket[defform] enhancements} + +@subsection{Easy rendering of quotes and syntax reader abbreviations} + +The six common reader abbreviations are rendered as +expected, using a heuristic on source locations (so that +@tt{#`} renders as @tt{#`} and not @tt{quasisyntax} when the +source location span is exactly two characters, for +example). + +@racketblock[ + @defform[#:kind "example" + (example-1 a + #'(b arg …) + #`(c arg …) + ((unsyntax 'unsyntax) (d arg …)) + 'd + `e + ,f + (@#,RACKET[syntax] (e arg …)) + (@#,RACKET[quasisyntax] (f arg …)) + (@#,RACKET[unsyntax] (g arg …)) + (@#,RACKET[quote] d) + (@#,RACKET[quasiquote] e) + (@#,RACKET[unquote] f))]] + +The above example renders as (with reader abbreviations for +the first six, but not for the last six): + +@nested[#:style 'code-inset]{ + @defform[#:kind "example" + (example-1 a + #'(b arg …) + #`(c arg …) + #,(d arg …) + 'd + `e + ,f + (syntax (a arg …)) + (quasisyntax (b arg …)) + (unsyntax (c arg …)) + (quote d) + (quasiquote e) + (unquote f))] +} + +@subsubsection{Escaping from @racket[defform]} + +Escaping from defform using @racket[UNSYNTAX] is not +implemented yet. + +@subsection{@racket[#:result] for @racket[defform]} + +@racketblock[ + @defform[#:kind "example" + (example-2 a #'([b c] ...)) + #:result void? + #:contracts ([a port?] + [b number?] + [c string?])]{ + Example description + }] + +The code above renders as follows: + +@nested[#:style 'code-inset]{ + @defform[#:kind "example" + (example-2 a #'([b c] ...)) + #:result void? + #:contracts ([a port?] + [b number?] + [c string?])]{ + Example description + } +} + +@subsection{Arbitrary rewriting of code in @racket[racketblock] and similar} + +@defthing[#:kind "mutable-match-lambda" + mutable-match-element-id-transformer]{As an example, it would be + possible to create a rewrite handler which turns the ⁰¹²³⁴⁵⁶⁷⁸⁹ unicode + superscripts at the end of identifiers into superscripts alongside the + base identifier. + + This could be useful to typeset code using the @elem[#:style 'tt "xlist"] + package, which rewrites identifiers ending with a superscript to mean + repetition, so that @racket[(define-type three-ints (xList Integer³))] is + equivalent to @racket[(define-type three-ints (List Integer Integer Integer))]. + + @racketblock[ + @(code:comment "Correctly display xyz⃰, xyzⁿ, xyz⁰, xyz¹, … xyz⁹") + (begin-for-syntax + (mutable-match-lambda-add-overriding-clause! + mutable-match-element-id-transformer + #:match-lambda + [(? identifier? + whole-id + (app (compose symbol->string syntax-e) + (pregexp #px"^(.*?)(⃰|ⁿ|[⁰¹²³⁴⁵⁶⁷⁸⁹]+)$" + (list whole base power)))) + (define/with-syntax base-id (format-id whole-id "~a" base)) + (define/with-syntax power-characters + (string-join + (map (match-lambda ["⃰" "*"] + ["ⁿ" "n"] + ["⁰" "0"] ["¹" "1"] ["²" "2"] ["³" "3"] ["⁴" "4"] + ["⁵" "5"] ["⁶" "6"] ["⁷" "7"] ["⁸" "8"] ["⁹" "9"]) + (map string (string->list power))))) + #'(elem (list (racket base-id) + (superscript power-characters)))]))] + + Another use case would be a hack to correctly colour syntax classes from + syntax-parse, when used as @racket[attr:stxclass]. Here is how it would be + defined: + + @racketblock[ + (begin-for-syntax + (mutable-match-lambda-add-overriding-clause! + mutable-match-element-id-transformer + #:match-lambda + [(? identifier? + whole-id + (app (compose symbol->string syntax-e) + (pregexp #px"^([^:]*):([^:]*)$" + (list whole attr cls)))) + (define/with-syntax attr-id (format-id whole-id "~a" attr)) + (define/with-syntax cls-id (format-id whole-id "~a" cls)) + #'(elem (list (racket attr-id) + (elem #:style 'tt ":") + (racket cls-id)))]))] + + The code for these two examles would be inserted directly inside the document, + before any @racket[racketblock], @racket[chunk] or similar.} + +@defthing[#:kind "syntax property" + scribble-render]{ + The @racket['scribble-render] syntax property can contain a function. It will + be called with the whole syntax object, and must return the syntax for + scribble code which will be used in place of that s-expression. + + This feature is experimental, and may be changed in future versions. + + @history[#:added "0.2" + #:changed "0.3" + @elem{Deprecated in favour of @racket[scribble-render-as].}] + + @deprecated[#:what "syntax property" + @racket[scribble-render-as]]{ + Deprecated as of @racketmodname[scribble-enhanced] version 0.3, because + @racket['scribble-render] only supports single-line replacements. The new + @racket['scribble-render-as] property is more flexible.}} + +@defthing[#:kind "syntax property" + scribble-render-as]{ + The @racket['scribble-render-as] syntax property can contain a function. It + will be called with six argumens: + + @defproc[(scribble-render-as-proc + [self syntax?] + [id identifier?] + [typeset-expr syntax?] + [uncode-id identifier?] + [d->s-expr syntax?] + [stx-prop-expr syntax?]) + stx-list?]{} + + The first argument, @racket[self], is the whole syntax object bearing the + @racket['scribble-render-as] property. The other arguments are the (quoted + syntax form of) the arguments passed to the @racket[define-code] macro which + generated the form currently rendering the code. The most useful argument is + @racket[uncode], indicating which identifier should be used in place of + @racket[unsyntax] to escape the current form, which will be + @racket[racketblock], @racket[RACKETBLOCK] or another similar form. + + The function must return a syntax object which will be spliced in place of the + original when rendering. Note that the returned syntax object will be spliced, + i.e. the outer pair of parentheses removed. If the original syntax object must + be replaced by @racket[foo], then @racket[#'foo] must be returned. The splicing + operation allows several tokens to be rendered. For example, in + @racket[(racketblock a b c)], if @racket[b] has the + @racket['scribble-render-as] property, and the function returns + @racket[#'(x y z)], then the whole form will be rendered like + @racket[(racketblock a x y z c)]. + + As an example, here is the @racket['scribble-render-as] procedure used by + @racketmodname[aful #:indirect], to render the lambda shorthand notation + @racket["#λ(+ % 1)"]: + + @racketblock[ + (define (aful-scribble-render self id code typeset-code uncode d->s stx-prop) + (syntax-case self () + (code:comment "#λ(body) reads as:") + (code:comment "(lambda args") + (code:comment " (define-syntax % (make-rename-transformer #'%1))") + (code:comment " body)") + [(_ _ _ body) + (with-syntax ([uncode (datum->syntax uncode (syntax-e uncode) self)]) + (syntax/top-loc self + ((uncode(seclink "_lang_aful" + #:doc '(lib "aful/docs/aful.scrbl") + (tt "#λ"))) + body)))]))] + + This feature is experimental, and may be changed in future versions. + + @history[#:added "0.3"]} +\ No newline at end of file diff --git a/unicode-chars.sty.rkt b/unicode-chars.sty.rkt @@ -0,0 +1,411 @@ +#lang at-exp racket +(provide unicode-chars) +(define unicode-chars + @string-append|<<<{ +\input glyphtounicode +\pdfgentounicode=1 +\usepackage{accsupp} +%$\BeginAccSupp{method=hex,unicode,ActualText=2200}∀\EndAccSupp{} +% \BeginAccSupp{method=hex,unicode,ActualText=2192}→\EndAccSupp{}$ +\usepackage{bbold} +\usepackage{savesym} +\savesymbol{iint} +\savesymbol{iiint} +\savesymbol{dddot} +\savesymbol{ddddot} +\savesymbol{overleftrightarrow} +\savesymbol{underrightarrow} +\savesymbol{underleftarrow} +\savesymbol{underleftrightarrow} +\usepackage{amsmath} +\restoresymbol{ams}{iint} +\restoresymbol{ams}{iiint} +\restoresymbol{ams}{dddot} +\restoresymbol{ams}{ddddot} +\restoresymbol{ams}{underrightarrow} +\restoresymbol{ams}{underleftarrow} +\restoresymbol{ams}{underleftrightarrow} +\savesymbol{ulcorner} +\savesymbol{urcorner} +\savesymbol{llcorner} +\savesymbol{lrcorner} +\usepackage{amsfonts} +\restoresymbol{ams}{ulcorner} +\restoresymbol{ams}{urcorner} +\restoresymbol{ams}{llcorner} +\restoresymbol{ams}{lrcorner} +\usepackage{mathtools} +\usepackage{tikz} +% rename mathabx's version of triangleright +\let\mathabxtriangleright\triangleright +% restore symbol overridden by mathabx in Scribble's preamble to the default one +\def\triangleright{\mathchar"212E} +\makeatletter +% Must be loaded after MnSymbol!!! MnSymbol improperly defines × and ¬ in such a +% way that they don't work in math mode. +% definition of some characters, for use with +% \usepackage[utf8]{inputenc} +% \usepackage[T1]{fontenc} +% Author: Christoph Lange <math.semantic.web@gmail.com> +% Some math characters taken from John Wickerson's MathUnicode.sty +% (http://tex.stackexchange.com/questions/110042/ +% entering-unicode-math-symbols-into-latex-direct-from-keyboard-on-a-mac) +% https://github.com/clange/latex +\NeedsTeXFormat{LaTeX2e}[1999/12/01] +%\ProvidesPackage{unicode-chars}[2013/10/08] + +\DeclareUnicodeCharacter{00A0}{~}% " " (nbsp) +\DeclareUnicodeCharacter{00A3}{\pounds}% £ +\DeclareUnicodeCharacter{00AB}{% + \ifmmode\textrm{\guillemotleft}\else\guillemotleft\fi}%« +% Declared by MnSymbol: +\DeclareUnicodeCharacter{00AC}{\ensuremath{\neg}}% ¬ +\DeclareUnicodeCharacter{00AE}{\textsuperscript{\textregistered}}% ® +\DeclareUnicodeCharacter{00AF}{\ensuremath{^-}}% ¯ +\DeclareUnicodeCharacter{00BB}{% + \ifmmode\textrm{\guillemotright}\else\guillemotright\fi}%» +% Declared by MnSymbol: +\DeclareUnicodeCharacter{00D7}{\ensuremath{\times}}% × +\DeclareUnicodeCharacter{00F1}{{\ifmmode\tilde{n}\else\~{n}\fi}}% ñ + +\DeclareUnicodeCharacter{0101}{\=a}% ā +\DeclareUnicodeCharacter{0123}{\c g}% ģ +\DeclareUnicodeCharacter{0130}{\. I}% İ +\DeclareUnicodeCharacter{0146}{\c n}% ņ +\DeclareUnicodeCharacter{016B}{\=u}% ū +\DeclareUnicodeCharacter{03B1}{\ensuremath{\alpha}}% α +\DeclareUnicodeCharacter{03B4}{\ensuremath{\delta}}% δ +\DeclareUnicodeCharacter{0394}{\ensuremath{\Delta}}% Δ +\DeclareUnicodeCharacter{03F5}{\ensuremath{\epsilon}}% ϵ +\DeclareUnicodeCharacter{03B5}{\ensuremath{\varepsilon}}% ε +\DeclareUnicodeCharacter{0395}{\ensuremath{\Epsilon}}% Ε +\DeclareUnicodeCharacter{03BB}{\ensuremath{\lambda}}% λ +\DeclareUnicodeCharacter{039B}{\ensuremath{\Lambda}}% Λ +\DeclareUnicodeCharacter{03C1}{\ensuremath{\rho}}% ρ +\DeclareUnicodeCharacter{03A1}{\ensuremath{\Rho}}% Ρ +\DeclareUnicodeCharacter{2190}{\ensuremath{\leftarrow}}% ← +\DeclareUnicodeCharacter{2192}{\ensuremath{\BeginAccSupp{method=hex,unicode,ActualText=2192}\rightarrow\EndAccSupp{}}}% → +% 2192: \textrightarrow is not available in all fonts, +% and we need the right arrow in math mode +\DeclareUnicodeCharacter{2193}{\ensuremath{\downarrow}}% ↓ +\DeclareUnicodeCharacter{2194}{\ensuremath{\leftrightarrow}}% ↔ +\DeclareUnicodeCharacter{21A6}{\ensuremath{\mapsto}}% ↦ +\DeclareUnicodeCharacter{21C0}{\ensuremath{\rightharpoonup}}% ⇀ +\DeclareUnicodeCharacter{21D2}{\ensuremath{\Rightarrow}}% ⇒ +% Suzanne — added \operatorname{} in ∀ . +\DeclareUnicodeCharacter{2200}{\ensuremath{\operatorname{\BeginAccSupp{method=hex,unicode,ActualText=2200}\forall\EndAccSupp{}}}}% ∀ +\DeclareUnicodeCharacter{2203}{\ensuremath{\exists}}% ∃ +\DeclareUnicodeCharacter{2208}{\ensuremath{\in}}% ∈ +\DeclareUnicodeCharacter{2209}{\ensuremath{\not\in}}% ∉ +\DeclareUnicodeCharacter{2211}{\ensuremath{\sum}}% ∑ +\DeclareUnicodeCharacter{220F}{\ensuremath{\prod}}% ∏ +\DeclareUnicodeCharacter{2218}{\ensuremath{\circ}}% ∘ +\DeclareUnicodeCharacter{2227}{\ensuremath{\mathbin{\wedge}}}% ∧ +\DeclareUnicodeCharacter{2228}{\ensuremath{\mathbin{\vee}}}% ∨ +\DeclareUnicodeCharacter{2229}{\ensuremath{\mathbin{\cap}}}% ∩ +\DeclareUnicodeCharacter{222A}{\ensuremath{\mathbin{\cup}}}% ∪ +\DeclareUnicodeCharacter{228D}{\ensuremath{\mathbin{\cupdot}}}% ⊍ +\DeclareUnicodeCharacter{228E}{\ensuremath{\mathbin{\uplus}}}% ⊎ +%\DeclareUnicodeCharacter{2237}{\ensuremath{::}}% ∷ +% 2237: not sure that's a good way to render this symbol +\DeclareUnicodeCharacter{2248}{\ensuremath{\approx}}% ≈ +\DeclareUnicodeCharacter{2260}{\ensuremath{\ne}}% ≠ +\DeclareUnicodeCharacter{2261}{\ensuremath{\equiv}}% ≡ +\DeclareUnicodeCharacter{2262}{\ensuremath{\not\equiv}}% ≢ +\DeclareUnicodeCharacter{2264}{\ensuremath{\le}}% ≤ +\DeclareUnicodeCharacter{2265}{\ensuremath{\ge}}% ≥ +\DeclareUnicodeCharacter{2286}{\ensuremath{\subseteq}}% ⊆ +\DeclareUnicodeCharacter{2282}{\ensuremath{\subset}}% ⊂ +\DeclareUnicodeCharacter{2287}{\ensuremath{\supseteq}}% ⊇ +\DeclareUnicodeCharacter{2283}{\ensuremath{\supset}}% ⊃ +\DeclareUnicodeCharacter{219D}{\ensuremath{\leadsto}}% ↝ +\@ifpackageloaded{MnSymbol}{% +\DeclareUnicodeCharacter{2295}{\ensuremath{\oplus}}% ⊕ +\DeclareUnicodeCharacter{2296}{\ensuremath{\ominus}}% ⊖ +}{} +\DeclareUnicodeCharacter{22C0}{\ensuremath{\bigwedge}}% ⋀ +\DeclareUnicodeCharacter{22C0}{\ensuremath{\bigcupdot}}% ⋀ % TODO?! +\DeclareUnicodeCharacter{22C1}{\ensuremath{\biguplus}}% ⋁ % TODO?! +\DeclareUnicodeCharacter{22C2}{\ensuremath{\bigcap}}% ⋂ +\DeclareUnicodeCharacter{22C3}{\ensuremath{\bigcup}}% ⋃ +\DeclareUnicodeCharacter{2A03}{\ensuremath{\bigcupdot}}% ⨃ +\DeclareUnicodeCharacter{2A04}{\ensuremath{\biguplus}}% ⨄ +\DeclareUnicodeCharacter{25CB}{\ensuremath{\ocircle}}% ○ +\@ifpackageloaded{MnSymbol}{% +\DeclareUnicodeCharacter{2605}{\ensuremath{\filledlargestar}}% ★ +}{} +\DeclareUnicodeCharacter{2713}{\ensuremath{\checkmark}}% ✓ +\DeclareUnicodeCharacter{27F6}{\ensuremath{\longrightarrow}}% ⟶ +\DeclareUnicodeCharacter{27F7}{\ensuremath{\longleftrightarrow}}% ⟷ +\DeclareUnicodeCharacter{27F9}{\ensuremath{\Longrightarrow}}% ⟹ +% +% Additions by Suzanne Soy +\DeclareUnicodeCharacter{2237}{\ensuremath{\dblcolon}}% ∷ +\DeclareUnicodeCharacter{228F}{\ensuremath{\sqsubset}}% ⊏ +\DeclareUnicodeCharacter{2290}{\ensuremath{\sqsubset}}% ⊐ +\DeclareUnicodeCharacter{2291}{\ensuremath{\sqsubseteq}}% ⊑ +\DeclareUnicodeCharacter{2292}{\ensuremath{\sqsupseteq}}% ⊒ +\DeclareUnicodeCharacter{2293}{\ensuremath{\sqcap}}% ⊓ +\DeclareUnicodeCharacter{2294}{\ensuremath{\sqcup}}% ⊔ +% +\usepackage{graphicx}% +\providecommand{\bigsqcap}{% + \mathop{% + \mathpalette\@updown\bigsqcup + }% +} +\newcommand*{\@updown}[2]{% + \rotatebox[origin=c]{180}{$\m@th#1#2$}% +} +\DeclareUnicodeCharacter{2A05}{\ensuremath{\bigsqcap}}% ⨅ +\DeclareUnicodeCharacter{2A06}{\ensuremath{\bigsqcup}}% ⨆ +\DeclareUnicodeCharacter{2080}{\ensuremath{{}_0}}% ₀ +\DeclareUnicodeCharacter{2081}{\ensuremath{\BeginAccSupp{method=hex,unicode,ActualText=2081}{}_1\EndAccSupp{}}}% ₁ +\DeclareUnicodeCharacter{2082}{\ensuremath{{}_2}}% ₂ +\DeclareUnicodeCharacter{2083}{\ensuremath{{}_3}}% ₃ +\DeclareUnicodeCharacter{2084}{\ensuremath{{}_4}}% ₄ +\DeclareUnicodeCharacter{2085}{\ensuremath{{}_5}}% ₅ +\DeclareUnicodeCharacter{2086}{\ensuremath{{}_6}}% ₆ +\DeclareUnicodeCharacter{2087}{\ensuremath{{}_7}}% ₇ +\DeclareUnicodeCharacter{2088}{\ensuremath{{}_8}}% ₈ +\DeclareUnicodeCharacter{2089}{\ensuremath{{}_9}}% ₉ +\DeclareUnicodeCharacter{208A}{\ensuremath{{}_+}}% ₊ +\DeclareUnicodeCharacter{208B}{\ensuremath{{}_-}}% ₋ +\DeclareUnicodeCharacter{208C}{\ensuremath{{}_=}}% ₌ +\DeclareUnicodeCharacter{208D}{\ensuremath{{}_(}}% ₍ +\DeclareUnicodeCharacter{208E}{\ensuremath{{}_)}}% ₎ +\DeclareUnicodeCharacter{2098}{\ensuremath{{}_m}}% ₘ +\DeclareUnicodeCharacter{2099}{\ensuremath{{}_n}}% ₙ +\DeclareUnicodeCharacter{2095}{\ensuremath{{}_h}}% ₕ +\DeclareUnicodeCharacter{1D62}{\ensuremath{{}_i}}% ᵢ +\DeclareUnicodeCharacter{2C7C}{\ensuremath{{}_j}}% ⱼ +\DeclareUnicodeCharacter{2096}{\ensuremath{{}_k}}% ₖ +\DeclareUnicodeCharacter{2097}{\ensuremath{{}_l}}% ₗ +\DeclareUnicodeCharacter{209B}{\ensuremath{{}_s}}% ₛ +% +\DeclareUnicodeCharacter{2070}{\ensuremath{{}^0}}% ⁰ +%\DeclareUnicodeCharacter{00B9}{\ensuremath{{}^1}}% ¹ +%\DeclareUnicodeCharacter{00B2}{\ensuremath{{}^2}}% ² +%\DeclareUnicodeCharacter{00B3}{\ensuremath{{}^3}}% ³ +\DeclareUnicodeCharacter{2074}{\ensuremath{{}^4}}% ⁴ +\DeclareUnicodeCharacter{2075}{\ensuremath{{}^5}}% ⁵ +\DeclareUnicodeCharacter{2076}{\ensuremath{{}^6}}% ⁶ +\DeclareUnicodeCharacter{2077}{\ensuremath{{}^7}}% ⁷ +\DeclareUnicodeCharacter{2078}{\ensuremath{{}^8}}% ⁸ +\DeclareUnicodeCharacter{2079}{\ensuremath{{}^9}}% ⁹ +\DeclareUnicodeCharacter{207A}{\ensuremath{{}^+}}% ⁺ +\DeclareUnicodeCharacter{207B}{\ensuremath{{}^-}}% ⁻ +\DeclareUnicodeCharacter{207C}{\ensuremath{{}^=}}% ⁼ +\DeclareUnicodeCharacter{207D}{\ensuremath{{}^(}}% ⁽ +\DeclareUnicodeCharacter{207E}{\ensuremath{{}^)}}% ⁾ +\DeclareUnicodeCharacter{207F}{\ensuremath{{}^n}}% ⁿ +\DeclareUnicodeCharacter{2071}{\ensuremath{{}^i}}% ⁱ +\DeclareUnicodeCharacter{02B2}{\ensuremath{{}^j}}% ʲ +\DeclareUnicodeCharacter{1D4F}{\ensuremath{{}^k}}% ᵏ +\DeclareUnicodeCharacter{2093}{\ensuremath{{}_x}}% ₓ +%s +\DeclareUnicodeCharacter{2026}{\ensuremath{\dots}}% … + +% Generated from ~/.XCompose using: +% cat /tmp/cal.txt | cut -d '"' -f 2- | tr '"' ' ' | cut -d ' ' -f 1,6 \ +% | while IFS=' ' read a b; do +% echo -n "\\DeclareUnicodeCharacter{$(printf "%X" "'$a")}" +% echo "{\\\\ensuremath{\\mathcal{$b}}}% $a"; +% done + +\DeclareUnicodeCharacter{1D49C}{\ensuremath{\mathcal{A}}}% 𝒜 +\DeclareUnicodeCharacter{212C}{\ensuremath{\mathcal{B}}}% ℬ +\DeclareUnicodeCharacter{1D49E}{\ensuremath{\mathcal{C}}}% 𝒞 +\DeclareUnicodeCharacter{1D49F}{\ensuremath{\mathcal{D}}}% 𝒟 +\DeclareUnicodeCharacter{2130}{\ensuremath{\mathcal{E}}}% ℰ +\DeclareUnicodeCharacter{2131}{\ensuremath{\mathcal{F}}}% ℱ +\DeclareUnicodeCharacter{1D4A2}{\ensuremath{\mathcal{G}}}% 𝒢 +\DeclareUnicodeCharacter{210B}{\ensuremath{\mathcal{H}}}% ℋ +\DeclareUnicodeCharacter{2110}{\ensuremath{\mathcal{I}}}% ℐ +\DeclareUnicodeCharacter{1D4A5}{\ensuremath{\mathcal{J}}}% 𝒥 +\DeclareUnicodeCharacter{1D4A6}{\ensuremath{\mathcal{K}}}% 𝒦 +\DeclareUnicodeCharacter{2112}{\ensuremath{\mathcal{L}}}% ℒ +\DeclareUnicodeCharacter{2133}{\ensuremath{\mathcal{M}}}% ℳ +\DeclareUnicodeCharacter{1D4A9}{\ensuremath{\mathcal{N}}}% 𝒩 +\DeclareUnicodeCharacter{1D4AA}{\ensuremath{\mathcal{O}}}% 𝒪 +\DeclareUnicodeCharacter{1D4AB}{\ensuremath{\mathcal{P}}}% 𝒫 +\DeclareUnicodeCharacter{1D4AC}{\ensuremath{\mathcal{Q}}}% 𝒬 +\DeclareUnicodeCharacter{211B}{\ensuremath{\mathcal{R}}}% ℛ +\DeclareUnicodeCharacter{1D4AE}{\ensuremath{\mathcal{S}}}% 𝒮 +\DeclareUnicodeCharacter{1D4AF}{\ensuremath{\mathcal{T}}}% 𝒯 +\DeclareUnicodeCharacter{1D4B0}{\ensuremath{\mathcal{U}}}% 𝒰 +\DeclareUnicodeCharacter{1D4B1}{\ensuremath{\mathcal{V}}}% 𝒱 +\DeclareUnicodeCharacter{1D4B2}{\ensuremath{\mathcal{W}}}% 𝒲 +\DeclareUnicodeCharacter{1D4B3}{\ensuremath{\mathcal{X}}}% 𝒳 +\DeclareUnicodeCharacter{1D4B4}{\ensuremath{\mathcal{Y}}}% 𝒴 +\DeclareUnicodeCharacter{1D4B5}{\ensuremath{\mathcal{Z}}}% 𝒵 +\DeclareUnicodeCharacter{1D4B6}{\ensuremath{\mathcal{a}}}% 𝒶 +\DeclareUnicodeCharacter{1D4B7}{\ensuremath{\mathcal{b}}}% 𝒷 +\DeclareUnicodeCharacter{1D4B8}{\ensuremath{\mathcal{c}}}% 𝒸 +\DeclareUnicodeCharacter{1D4B9}{\ensuremath{\mathcal{d}}}% 𝒹 +\DeclareUnicodeCharacter{212F}{\ensuremath{\mathcal{e}}}% ℯ +\DeclareUnicodeCharacter{1D4BB}{\ensuremath{\mathcal{f}}}% 𝒻 +\DeclareUnicodeCharacter{210A}{\ensuremath{\mathcal{g}}}% ℊ +\DeclareUnicodeCharacter{1D4BD}{\ensuremath{\mathcal{h}}}% 𝒽 +\DeclareUnicodeCharacter{1D4BE}{\ensuremath{\mathcal{i}}}% 𝒾 +\DeclareUnicodeCharacter{1D4BF}{\ensuremath{\mathcal{j}}}% 𝒿 +\DeclareUnicodeCharacter{1D4C0}{\ensuremath{\mathcal{k}}}% 𝓀 +\DeclareUnicodeCharacter{1D4C1}{\ensuremath{\mathcal{l}}}% 𝓁 +\DeclareUnicodeCharacter{1D4C2}{\ensuremath{\mathcal{m}}}% 𝓂 +\DeclareUnicodeCharacter{1D4C3}{\ensuremath{\mathcal{n}}}% 𝓃 +\DeclareUnicodeCharacter{2134}{\ensuremath{\mathcal{o}}}% ℴ +\DeclareUnicodeCharacter{1D4C5}{\ensuremath{\mathcal{p}}}% 𝓅 +\DeclareUnicodeCharacter{1D4C6}{\ensuremath{\mathcal{q}}}% 𝓆 +\DeclareUnicodeCharacter{1D4C7}{\ensuremath{\mathcal{r}}}% 𝓇 +\DeclareUnicodeCharacter{1D4C8}{\ensuremath{\mathcal{s}}}% 𝓈 +\DeclareUnicodeCharacter{1D4C9}{\ensuremath{\mathcal{t}}}% 𝓉 +\DeclareUnicodeCharacter{1D4CA}{\ensuremath{\mathcal{u}}}% 𝓊 +\DeclareUnicodeCharacter{1D4CB}{\ensuremath{\mathcal{v}}}% 𝓋 +\DeclareUnicodeCharacter{1D4CC}{\ensuremath{\mathcal{w}}}% 𝓌 +\DeclareUnicodeCharacter{1D4CD}{\ensuremath{\mathcal{x}}}% 𝓍 +\DeclareUnicodeCharacter{1D4CE}{\ensuremath{\mathcal{y}}}% 𝓎 +\DeclareUnicodeCharacter{1D4CF}{\ensuremath{\mathcal{z}}}% 𝓏 +\DeclareUnicodeCharacter{220C}{\ensuremath{\not\ni}}% ∌ +\DeclareUnicodeCharacter{220B}{\ensuremath{\ni}}% ∋ +\DeclareUnicodeCharacter{2008}{\,}% Punctuation space +\DeclareUnicodeCharacter{2032}{\ensuremath{'}}% ′ (Prime) +\DeclareUnicodeCharacter{2033}{\ensuremath{''}}% ″ (2x Prime) +\DeclareUnicodeCharacter{2034}{\ensuremath{'''}}% ‴ (3x Prime) +\DeclareUnicodeCharacter{2057}{\ensuremath{''''}}% ⁗ (4x Prime) +\DeclareUnicodeCharacter{1D538}{\ensuremath{\mathbb{A}}}% 𝔸 +\DeclareUnicodeCharacter{1D539}{\ensuremath{\mathbb{B}}}% 𝔹 +\DeclareUnicodeCharacter{2102}{\ensuremath{\mathbb{C}}}% ℂ +\DeclareUnicodeCharacter{1D53B}{\ensuremath{\mathbb{D}}}% 𝔻 +\DeclareUnicodeCharacter{1D53C}{\ensuremath{\mathbb{E}}}% 𝔼 +\DeclareUnicodeCharacter{1D53D}{\ensuremath{\mathbb{F}}}% 𝔽 +\DeclareUnicodeCharacter{1D53E}{\ensuremath{\mathbb{G}}}% 𝔾 +\DeclareUnicodeCharacter{210D}{\ensuremath{\mathbb{H}}}% ℍ +\DeclareUnicodeCharacter{1D540}{\ensuremath{\mathbb{I}}}% 𝕀 +\DeclareUnicodeCharacter{1D541}{\ensuremath{\mathbb{J}}}% 𝕁 +\DeclareUnicodeCharacter{1D542}{\ensuremath{\mathbb{K}}}% 𝕂 +\DeclareUnicodeCharacter{1D543}{\ensuremath{\mathbb{L}}}% 𝕃 +\DeclareUnicodeCharacter{1D544}{\ensuremath{\mathbb{M}}}% 𝕄 +\DeclareUnicodeCharacter{2115}{\ensuremath{\mathbb{N}}}% ℕ +\DeclareUnicodeCharacter{1D546}{\ensuremath{\mathbb{O}}}% 𝕆 +\DeclareUnicodeCharacter{2119}{\ensuremath{\mathbb{P}}}% ℙ +\DeclareUnicodeCharacter{211A}{\ensuremath{\mathbb{Q}}}% ℚ +\DeclareUnicodeCharacter{211D}{\ensuremath{\mathbb{R}}}% ℝ +\DeclareUnicodeCharacter{1D54A}{\ensuremath{\mathbb{S}}}% 𝕊 +\DeclareUnicodeCharacter{1D54B}{\ensuremath{\mathbb{T}}}% 𝕋 +\DeclareUnicodeCharacter{1D54C}{\ensuremath{\mathbb{U}}}% 𝕌 +\DeclareUnicodeCharacter{1D54D}{\ensuremath{\mathbb{V}}}% 𝕍 +\DeclareUnicodeCharacter{1D54E}{\ensuremath{\mathbb{W}}}% 𝕎 +\DeclareUnicodeCharacter{1D54F}{\ensuremath{\mathbb{X}}}% 𝕏 +\DeclareUnicodeCharacter{1D550}{\ensuremath{\mathbb{Y}}}% 𝕐 +\DeclareUnicodeCharacter{2124}{\ensuremath{\mathbb{Z}}}% ℤ +\DeclareUnicodeCharacter{213C}{\ensuremath{\mathbb{\pi}}}% ℼ +\DeclareUnicodeCharacter{213D}{\ensuremath{\mathbb{\gamma}}}% ℽ +\DeclareUnicodeCharacter{213E}{\ensuremath{\mathbb{\Gamma}}}% ℾ +\DeclareUnicodeCharacter{213F}{\ensuremath{\mathbb{\Pi}}}% ℿ +\DeclareUnicodeCharacter{2140}{\ensuremath{\mathbb{\Sigma}}}% ⅀ +\DeclareUnicodeCharacter{1D7D8}{\ensuremath{\mathbb{0}}}% 𝟘 +\DeclareUnicodeCharacter{1D7D9}{\ensuremath{\mathbb{1}}}% 𝟙 +\DeclareUnicodeCharacter{1D7DA}{\ensuremath{\mathbb{2}}}% 𝟚 +\DeclareUnicodeCharacter{1D7DB}{\ensuremath{\mathbb{3}}}% 𝟛 +\DeclareUnicodeCharacter{1D7DC}{\ensuremath{\mathbb{4}}}% 𝟜 +\DeclareUnicodeCharacter{1D7DD}{\ensuremath{\mathbb{5}}}% 𝟝 +\DeclareUnicodeCharacter{1D7DE}{\ensuremath{\mathbb{6}}}% 𝟞 +\DeclareUnicodeCharacter{1D7DF}{\ensuremath{\mathbb{7}}}% 𝟟 +\DeclareUnicodeCharacter{1D7E0}{\ensuremath{\mathbb{8}}}% 𝟠 +\DeclareUnicodeCharacter{1D7E1}{\ensuremath{\mathbb{9}}}% 𝟡 +\DeclareUnicodeCharacter{1D552}{\ensuremath{\mathbb{a}}}% 𝕒 +\DeclareUnicodeCharacter{1D553}{\ensuremath{\mathbb{b}}}% 𝕓 +\DeclareUnicodeCharacter{1D554}{\ensuremath{\mathbb{c}}}% 𝕔 +\DeclareUnicodeCharacter{1D555}{\ensuremath{\mathbb{d}}}% 𝕕 +\DeclareUnicodeCharacter{1D556}{\ensuremath{\mathbb{e}}}% 𝕖 +\DeclareUnicodeCharacter{1D557}{\ensuremath{\mathbb{f}}}% 𝕗 +\DeclareUnicodeCharacter{1D558}{\ensuremath{\mathbb{g}}}% 𝕘 +\DeclareUnicodeCharacter{1D559}{\ensuremath{\mathbb{h}}}% 𝕙 +\DeclareUnicodeCharacter{1D55A}{\ensuremath{\mathbb{i}}}% 𝕚 +\DeclareUnicodeCharacter{1D55B}{\ensuremath{\mathbb{j}}}% 𝕛 +\DeclareUnicodeCharacter{1D55C}{\ensuremath{\mathbb{k}}}% 𝕜 +\DeclareUnicodeCharacter{1D55D}{\ensuremath{\mathbb{l}}}% 𝕝 +\DeclareUnicodeCharacter{1D55E}{\ensuremath{\mathbb{m}}}% 𝕞 +\DeclareUnicodeCharacter{1D55F}{\ensuremath{\mathbb{n}}}% 𝕟 +\DeclareUnicodeCharacter{1D560}{\ensuremath{\mathbb{o}}}% 𝕠 +\DeclareUnicodeCharacter{1D561}{\ensuremath{\mathbb{p}}}% 𝕡 +\DeclareUnicodeCharacter{1D562}{\ensuremath{\mathbb{q}}}% 𝕢 +\DeclareUnicodeCharacter{1D563}{\ensuremath{\mathbb{r}}}% 𝕣 +\DeclareUnicodeCharacter{1D564}{\ensuremath{\mathbb{s}}}% 𝕤 +\DeclareUnicodeCharacter{1D565}{\ensuremath{\mathbb{t}}}% 𝕥 +\DeclareUnicodeCharacter{1D566}{\ensuremath{\mathbb{u}}}% 𝕦 +\DeclareUnicodeCharacter{1D567}{\ensuremath{\mathbb{v}}}% 𝕧 +\DeclareUnicodeCharacter{1D568}{\ensuremath{\mathbb{w}}}% 𝕨 +\DeclareUnicodeCharacter{1D569}{\ensuremath{\mathbb{x}}}% 𝕩 +\DeclareUnicodeCharacter{1D56A}{\ensuremath{\mathbb{y}}}% 𝕪 +\DeclareUnicodeCharacter{1D56B}{\ensuremath{\mathbb{z}}}% 𝕫 +\DeclareUnicodeCharacter{03C4}{\ensuremath{\tau}}% τ +\DeclareUnicodeCharacter{221E}{\ensuremath{\infty}}% ∞ +\DeclareUnicodeCharacter{219B}{\ensuremath{\nrightarrow}}% ↛ +\DeclareUnicodeCharacter{3C5}{\ensuremath{\upsilon}}% υ +\DeclareUnicodeCharacter{1D50}{\ensuremath{^m}}% ᵐ +\DeclareUnicodeCharacter{2205}{\ensuremath{\emptyset}}% ∅ +\DeclareUnicodeCharacter{3C3}{\ensuremath{\sigma}}% σ +\DeclareUnicodeCharacter{2254}{\ensuremath{\coloneqq}}% ≔ +\DeclareUnicodeCharacter{2A74}{\ensuremath{\Coloneqq}}% ⩴ +\DeclareUnicodeCharacter{2184}{\ensuremath{\reflectbox{$c$}}}% ↄ % TODO: \ifmmode +\DeclareUnicodeCharacter{A7FB}{\ensuremath{\reflectbox{$F$}}}% ꟻ +\DeclareUnicodeCharacter{250}{\ensuremath{\raisebox{\depth}{\rotatebox{180}{a}}}}% ɐ % TODO: \ifmmode +\DeclareUnicodeCharacter{393}{\ensuremath{\Gamma}}% Γ +\DeclareUnicodeCharacter{22A2}{\ensuremath{\vdash}}% ⊢ +\DeclareUnicodeCharacter{21AA}{\ensuremath{\hookrightarrow}}% ↪ +\DeclareUnicodeCharacter{2204}{\ensuremath{\nexists}}% ∄ +\DeclareUnicodeCharacter{3C6}{\ensuremath{\phi}}% φ +\DeclareUnicodeCharacter{3BA}{\ensuremath{\kappa}}% κ +\DeclareUnicodeCharacter{3B7}{\ensuremath{\eta}}% η +\DeclareUnicodeCharacter{22A4}{\ensuremath{\top}}% ⊤ +\DeclareUnicodeCharacter{3C0}{\ensuremath{\pi}}% π +\DeclareUnicodeCharacter{3A0}{\ensuremath{\Pi}}% Π +\DeclareUnicodeCharacter{2216}{\ensuremath{\setminus}}% ∖ +\DeclareUnicodeCharacter{22A5}{\ensuremath{\bot}}% ⊥ +\DeclareUnicodeCharacter{3C8}{\ensuremath{\psi}}% ψ +\DeclareUnicodeCharacter{3B2}{\ensuremath{\beta}}% β +\DeclareUnicodeCharacter{2772}{\tikz[baseline=0.2ex]\draw[line cap=round] (0,0) ++(-30:0.7ex) -- ++(-30:-0.7ex) -- ++(0,1.6ex) -- ++(30:0.7ex) {};}% ❲ +\DeclareUnicodeCharacter{2773}{\tikz[baseline=0.2ex]\draw[line cap=round] (0,0) ++(-150:0.7ex) -- ++(-150:-0.7ex) -- ++(0,1.6ex) -- ++(150:0.7ex) {};}% ❳ +\def\mediumlangle{% + \rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt% + \langle% +} +\def\mediumrangle{% + \rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt% + \rangle% +} +\def\boldlangle{% + \rlap{$\langle$}\kern 0.1pt\rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt\rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt\rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt\rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt\rlap{$\langle$}\kern 0.1pt% + \rlap{$\langle$}\kern 0.1pt\rlap{$\langle$}\kern 0.1pt% + \langle% +} +\def\boldrangle{% + \rlap{$\rangle$}\kern 0.1pt\rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt\rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt\rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt\rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt\rlap{$\rangle$}\kern 0.1pt% + \rlap{$\rangle$}\kern 0.1pt\rlap{$\rangle$}\kern 0.1pt% + \rangle% +} +\DeclareUnicodeCharacter{276C}{\ensuremath{\mediumlangle}}% ❬ +\DeclareUnicodeCharacter{276D}{\ensuremath{\mediumrangle}}% ❭ +\DeclareUnicodeCharacter{2770}{\ensuremath{\boldlangle}}% ❰ +\DeclareUnicodeCharacter{2771}{\ensuremath{\boldrangle}}% ❱ +\makeatother +}>>>|) diff --git a/with-manual.rkt b/with-manual.rkt @@ -0,0 +1,8 @@ +#lang racket/base + +(require racket/require + (subtract-in scribble/manual scribble-enhanced) + scribble-enhanced) + +(provide (all-from-out scribble/manual + scribble-enhanced))