From 0ecc65e134e1595d0255385700ee11351d6ad8a1f91b5b7d43d5e052a664bdaf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Linus=20Bj=C3=B6rnstam?= Date: Wed, 30 Sep 2026 15:51:24 +0200 Subject: [PATCH] textmate-bjolang: code highlighted as VS Code does, as Bjolang values MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TextMateSharp runs VS Code's TextMate grammars and themes; this hands the result over once, as Bjolang values, so nothing using it needs to know TextMateSharp is there. `tokenize` gives each line's tokens and their scopes, `highlight` each line's spans in the theme's colours, and `highlight->node` and `code->node` give (text xml) nodes: a pre and a code element around spans, coloured inline by the theme or by class names taken from the scopes. `highlighter-css` writes the stylesheet for the classes from a theme, choosing each class's rule the way TextMateSharp's tokenizer chooses a token's. Bjolang's own grammar is in grammars/bjolang, laid out as a VS Code extension, and every highlighter reads it from beside the package's src/. It follows what Bjolang's reader reads, including interpolated strings with expressions in their holes. There is no C# shim: everything goes through import/class and import/extern. The package is kept within TextMateSharp 2.0, because token colours are decoded with a class in its Internal namespace. 🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-7) Co-Authored-By: eca-agent --- .gitignore | 7 + LICENSE | 373 +++++++++ Readme.org | 168 ++++ grammars/bjolang/language-configuration.json | 23 + grammars/bjolang/package.json | 28 + .../bjolang/syntaxes/bjolang.tmLanguage.json | 410 +++++++++ manifest.bjodat | 16 + packages.lock.json | 29 + src/core.bjo | 777 ++++++++++++++++++ tests/demo.bjo | 181 ++++ 10 files changed, 2012 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 Readme.org create mode 100644 grammars/bjolang/language-configuration.json create mode 100644 grammars/bjolang/package.json create mode 100644 grammars/bjolang/syntaxes/bjolang.tmLanguage.json create mode 100644 manifest.bjodat create mode 100644 packages.lock.json create mode 100644 src/core.bjo create mode 100644 tests/demo.bjo diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ac014f9 --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +.bjo/ +*.dll +*.exe +*.pdb +*.bjobuild +*.runtimeconfig.json +*.deps.json diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d22367a --- /dev/null +++ b/LICENSE @@ -0,0 +1,373 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at https://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. diff --git a/Readme.org b/Readme.org new file mode 100644 index 0000000..be9f383 --- /dev/null +++ b/Readme.org @@ -0,0 +1,168 @@ +* textmate-bjolang — syntax highlighting, as Bjolang values + +Code highlighted the way VS Code highlights it: its TextMate grammars and its +colour themes, run by [[https://github.com/danipen/TextMateSharp][TextMateSharp]], +and handed over as Bjolang values — lines of tokens and their scopes, lines of +coloured spans — and as ~(text xml)~ nodes, ready for a page. + +#+BEGIN_SRC scheme +(import (textmate-bjolang core)) + +(def hl (highlighter #:theme 'dark-plus)) + +(match (find-language hl "c#") + ((Some cs) (highlight->node cs "var x = 1; // hi")) + (None ...)) +;; (pre (@ (class "tm") (style "color:#D4D4D4;background-color:#1E1E1E")) +;; (code (@ (class "language-csharp")) +;; (span (@ (style "color:#569CD6")) "var") " " +;; (span (@ (style "color:#9CDCFE")) "x") " = " +;; (span (@ (style "color:#B5CEA8")) "1") "; " +;; (span (@ (style "color:#6A9955")) "// hi"))) +#+END_SRC + +~(text xml write)~'s ~node->xml-string~ turns the node into markup. + +** What is highlighted + +VS Code's own grammars, 64 languages from C to YAML, and Bjolang, whose grammar +is part of this package. A language is found by its id, an alias or an +extension, in any case: ~"csharp"~, ~"C#"~, ~"cs"~ and ~".cs"~ are the same +language, and so are ~"bjolang"~, ~"bjo"~ and ~".bjo"~. + +The themes are VS Code's: ~'dark-plus~ ~'light-plus~ ~'dark~ ~'light~ ~'monokai~ +~'dimmed-monokai~ ~'one-dark~ ~'atom-one-dark~ ~'atom-one-light~ ~'dracula~ +~'solarized-dark~ ~'solarized-light~ ~'quiet-light~ ~'kimbie-dark~ +~'tomorrow-night-blue~ ~'abyss~ ~'red~ ~'high-contrast-dark~ ~'high-contrast-light~ +~'visual-studio-dark~ ~'visual-studio-light~. + +** Inline or classes + +A node is coloured one of two ways. + +~#:style 'inline~, the default, writes the theme's colours into ~style~ +attributes. The page needs nothing else, so it works in a feed, in a mail, or +pasted anywhere. + +~#:style 'classes~ writes class names taken from the grammar's scopes, and no +colours at all: + +#+BEGIN_SRC scheme +(highlight->node cs "var x = 1; // hi" #:style 'classes) +;; (pre (@ (class "tm")) +;; (code (@ (class "language-csharp")) +;; (span (@ (class "tm-storage tm-storage-type")) "var") " " +;; (span (@ (class "tm-entity tm-entity-name-variable")) "x") " " +;; (span (@ (class "tm-keyword tm-keyword-operator")) "=") " " +;; (span (@ (class "tm-constant tm-constant-numeric")) "1") +;; (span (@ (class "tm-punctuation")) ";") " " +;; (span (@ (class "tm-comment")) "// hi"))) +#+END_SRC + +A span has the general class and the particular one, from TextMate's +conventional scope names: ~tm-keyword~ to colour every keyword alike, +~tm-keyword-control~ to set ~if~ and ~return~ apart. The stylesheet is yours to +write, and a light and a dark one are only a media query apart. Or +~highlighter-css~ writes one from a theme: + +#+BEGIN_SRC scheme +(highlighter-css (highlighter #:theme 'light-plus) #:selector ".tm") +;; .tm{color:#000000;background-color:#FFFFFF} +;; .tm .tm-comment{color:#008000} +;; .tm .tm-string{color:#A31515} +;; ... +#+END_SRC + +It comes close to the theme without being it: a class is one scope, and a few +of a theme's rules look at the scopes around a token, or colour a ~meta.~ scope. + +~#:lines? #t~ puts each line in a ~(span (@ (class "line")) ...)~, for line +numbers or a highlighted line. + +** The values + +#+BEGIN_SRC scheme +(: TmToken (Record (: text string) (: scopes (Vec string)))) ; the outermost scope first +(: TmSpan (Record (: text string) (: style TmStyle))) +(: TmStyle (Record (: color (Option string)) ; None: the theme's own + (: background (Option string)) + (: bold bool) (: italic bool) (: underline bool) (: strikethrough bool))) +#+END_SRC + +~TmHighlighter~ and ~TmLanguage~ are opaque. Everything is prefixed ~Tm~, so +that the types can stand beside another library's. + +Some choices, made once here so that a user of the values need not: + +- A line is ended by ~\r\n~, ~\r~ or ~\n~, and a newline at the very end of the + code ends its last line rather than starting another. +- A span in the theme's default colour, or the editor's, has ~None~: the ~pre~ + around the code has that colour already. (Dark+ does not name a default for + its tokens, and TextMateSharp calls that black.) +- Whitespace is plain unless something would show on it: a background, or a + line under or through it. +- Neighbouring spans that look alike are one span. + +** The functions + +| ~(highlighter #:theme #:grammars #:line-time-limit)~ | the grammars and a theme; build it once | +| ~(find-language hl name)~ | ~(Option TmLanguage)~, by id, alias or extension | +| ~(language-names hl)~ | every language's id | +| ~(language-id lang)~ | its id | +| ~(tokenize lang code)~ | ~(Vec (Vec TmToken))~, a vec a line; no theme | +| ~(highlight lang code)~ | ~(Vec (Vec TmSpan))~, coloured by the theme | +| ~(token-classes token)~ | the classes ~#:style 'classes~ gives it | +| ~(highlight->node lang code #:style #:lines?)~ | a ~pre~ and a ~code~ element around the code | +| ~(highlight->nodes lang code #:style #:lines?)~ | only the ~code~ element's children | +| ~(code->node hl name code #:style #:lines?)~ | the same, named as a Markdown fence names it; plain text when the language is unknown | +| ~(highlighter-css hl #:selector)~ | a stylesheet for the classes in the theme | +| ~(highlighter-foreground hl)~, ~-background~ | the editor's colours | + +~code->node~ is the one for Markdown: the first word of ~"scheme title=x"~ +names the language, and an unknown one is set as plain text, in the same ~pre~. + +~#:grammars~ adds grammars of one's own: each a VS Code extension's +~package.json~, or the directory it is in. ~#:line-time-limit~ is how long one +line may take, 500 milliseconds unless it says otherwise; a line that takes +longer is cut there. + +** Bjolang's grammar + +~grammars/bjolang/~ is laid out as a VS Code extension is: ~package.json~, the +grammar in ~syntaxes/bjolang.tmLanguage.json~ and a language configuration, so +the directory can be one. Every highlighter reads it, from beside the ~src/~ +the package's DLL is in. + +It reads what Bjolang's reader reads: comments, strings over several lines, +interpolated strings with an expression in each hole, characters, booleans, +numbers, keywords, type variables and quoted symbols. It knows the special +forms, what a definition names and what a signature does, ~->~ and its kin, +capitalised names as types, and ~.Member~ and ~.-Property~. + +** Installing it + +#+BEGIN_SRC scheme +(depends + (package (name (textmate-bjolang)) + (version (version-at-least "0.1.0")) + (source (git (url "https://github.com/bjoli/textmate-bjolang"))))) +#+END_SRC + +The package declares TextMateSharp as a NuGet package, and a program using it +declares nothing itself. Building one needs the .NET SDK's ~dotnet~ command, +which restores it; see ~Docs/Projects.org~ in Bjolang, "NuGet packages", for +what that means for where the program runs. TextMateSharp runs its regular +expressions with Oniguruma, a native library, which the package carries for +Linux, macOS and Windows. + +** Running the tests + +#+BEGIN_SRC sh +bjo run tests/demo.bjo ;; 27 checks +#+END_SRC + +** Licence + +MPL-2.0. TextMateSharp, TextMateSharp.Grammars and Onigwrap are MIT, and +Oniguruma is BSD-2-Clause. VS Code's grammars and themes, which +TextMateSharp.Grammars carries, keep their own licences. diff --git a/grammars/bjolang/language-configuration.json b/grammars/bjolang/language-configuration.json new file mode 100644 index 0000000..b7a466e --- /dev/null +++ b/grammars/bjolang/language-configuration.json @@ -0,0 +1,23 @@ +{ + "comments": { + "lineComment": ";" + }, + "brackets": [ + ["(", ")"], + ["[", "]"], + ["{", "}"] + ], + "autoClosingPairs": [ + { "open": "(", "close": ")" }, + { "open": "[", "close": "]" }, + { "open": "{", "close": "}" }, + { "open": "\"", "close": "\"", "notIn": ["string", "comment"] } + ], + "surroundingPairs": [ + ["(", ")"], + ["[", "]"], + ["{", "}"], + ["\"", "\""] + ], + "wordPattern": "[^\\s()\\[\\]{},:\"';]+" +} diff --git a/grammars/bjolang/package.json b/grammars/bjolang/package.json new file mode 100644 index 0000000..e4d3cf7 --- /dev/null +++ b/grammars/bjolang/package.json @@ -0,0 +1,28 @@ +{ + "name": "bjolang", + "displayName": "Bjolang", + "description": "Syntax highlighting for Bjolang.", + "version": "0.1.0", + "publisher": "bjoli", + "license": "MPL-2.0", + "engines": { + "vscode": "^1.60.0" + }, + "contributes": { + "languages": [ + { + "id": "bjolang", + "aliases": ["Bjolang", "bjolang", "bjo"], + "extensions": [".bjo", ".protobjo"], + "configuration": "./language-configuration.json" + } + ], + "grammars": [ + { + "language": "bjolang", + "scopeName": "source.bjolang", + "path": "./syntaxes/bjolang.tmLanguage.json" + } + ] + } +} diff --git a/grammars/bjolang/syntaxes/bjolang.tmLanguage.json b/grammars/bjolang/syntaxes/bjolang.tmLanguage.json new file mode 100644 index 0000000..a481785 --- /dev/null +++ b/grammars/bjolang/syntaxes/bjolang.tmLanguage.json @@ -0,0 +1,410 @@ +{ + "$schema": "https://raw.githubusercontent.com/martinring/tmlanguage/master/tmlanguage.json", + "name": "Bjolang", + "scopeName": "source.bjolang", + "fileTypes": [ + "bjo", + "protobjo" + ], + "patterns": [ + { + "include": "#forms" + } + ], + "repository": { + "forms": { + "patterns": [ + { + "include": "#comment" + }, + { + "include": "#character" + }, + { + "include": "#boolean" + }, + { + "include": "#interpolated-string" + }, + { + "include": "#string" + }, + { + "include": "#hash-forms" + }, + { + "include": "#signature" + }, + { + "include": "#definition" + }, + { + "include": "#special-form" + }, + { + "include": "#keyword" + }, + { + "include": "#arrow" + }, + { + "include": "#member" + }, + { + "include": "#number" + }, + { + "include": "#type-variable" + }, + { + "include": "#quoted-symbol" + }, + { + "include": "#quote" + }, + { + "include": "#primitive-type" + }, + { + "include": "#type-name" + }, + { + "include": "#braces" + }, + { + "include": "#delimiter" + } + ] + }, + "comment": { + "comment": "A ; comment runs to the end of the line. There are no block comments.", + "match": "(;+).*$", + "name": "comment.line.semicolon.bjolang", + "captures": { + "1": { + "name": "punctuation.definition.comment.bjolang" + } + } + }, + "character": { + "comment": "#\\c, #\\space, #\\x41, #\\( — a name when more than one symbol character follows, otherwise the one character.", + "match": "(?event|record-ref|record-set|struct-ref|struct-set|yield-from|bjoroutine|with-open|spawn-evt|let/mono|when-let|with-run|time-it|unless|letrec|if-let|some->|match|begin|yield|spawn|when|case|else|let\\*|loop|seql|set!|cast|cond|let|seq|try|fun|and|not|bjo|if|do|or)(?![^\\s()\\[\\]{},:\"';])", + "captures": { + "1": { + "name": "keyword.control.bjolang" + } + } + } + ] + }, + "keyword": { + "comment": "#:keyword and :keyword, which is also how loop clauses and def's failure parts are written.", + "match": "#?:[^\\s()\\[\\]{},:\"';]+", + "name": "variable.parameter.keyword.bjolang" + }, + "arrow": { + "comment": "->, -bjo-> (a bjoroutine), -?-> (either colour), and =>.", + "match": "(?|-bjo->|-\\?->|=>)(?![^\\s()\\[\\]{},:\"';])", + "name": "storage.type.function.arrow.bjolang" + }, + "member": { + "patterns": [ + { + "match": "(?node cs "var x = 1;")) +;; (None ...)) +;; ;; => (pre (@ (class "tm") (style "color:#D4D4D4;background-color:#1E1E1E")) +;; ;; (code (@ (class "language-csharp")) +;; ;; (span (@ (style "color:#569CD6")) "var") " " ...)) +;; +;; A node is coloured one of two ways. 'inline writes the theme's colours into +;; style attributes, which works wherever HTML does. 'classes writes class +;; names taken from the grammar's scopes, which need no theme at all, and +;; highlighter-css turns a theme into a stylesheet for them. +;; +;; Bjolang's own grammar is in grammars/bjolang, beside src/, and every +;; highlighter reads it. +;; +;; Open: +;; - (text xml write) writes an empty element as , which HTML reads as an +;; open tag. Two things here can be empty: the code element of empty code, +;; and, under #:lines?, the last line of code that ends in a blank line. +;; - A class is the innermost scope the vocabulary knows. A theme rule that +;; looks at the scopes around a token ("meta.embedded string"), or colours a +;; meta. scope, has no class to go on, so highlighter-css's stylesheet is +;; close to the theme, not it: in VS Code's six best-known themes, about +;; one character in twenty of C#, JavaScript and Bjolang differs. +;; - TextMateSharp takes a theme's own rules before the ones it includes, +;; however specific: Light+ colours `this` as a variable, where VS Code +;; gives it the included theme's blue. Both styles here follow TextMateSharp. +;; - The Bjolang grammar is found beside the DLL. A program copied somewhere +;; without grammars/ — what a bjo publish would do — has no bjolang. +;; - A highlighter tokenizes one line at a time, under a lock: TextMateSharp +;; compiles a grammar's rules as it meets them and says nothing about +;; threads. Parallel work wants a highlighter per thread. +;; - A line that takes longer than the time limit is cut there, and the rest +;; of it is one token in the scope reached. +;; - Only VS Code's own themes. A theme file of one's own could be read with +;; TextMateSharp's ThemeReader and Registry.SetTheme. + +(export + TmTheme TmStyleMode TmHighlighter TmLanguage TmToken TmStyle TmSpan + highlighter highlighter-foreground highlighter-background highlighter-css + find-language language-id language-names + tokenize highlight token-classes + highlight->nodes highlight->node code->node) + +(import (std prelude)) +(import (only (std set) list->set set-contains?)) +(import (text xml)) + +;; --------------------------------------------------------------------------- +;; TextMateSharp +;; --------------------------------------------------------------------------- + +(import/class + (Object (: System.Object)) + (ThemeName (: TextMateSharp.Grammars.ThemeName)) + (RegistryOptions (: TextMateSharp.Grammars.RegistryOptions (-> ThemeName RegistryOptions))) + (IRegistryOptions (: TextMateSharp.Registry.IRegistryOptions)) + (Registry (: TextMateSharp.Registry.Registry (-> IRegistryOptions Registry))) + (ClrLanguage (: TextMateSharp.Grammars.Language)) + (Grammar (: TextMateSharp.Grammars.IGrammar)) + (StateStack (: TextMateSharp.Grammars.IStateStack)) + (LineText (: TextMateSharp.Grammars.LineText (-> string LineText))) + (ScopedResult (: TextMateSharp.Grammars.ITokenizeLineResult)) + (EncodedResult (: TextMateSharp.Grammars.ITokenizeLineResult2)) + (Token (: TextMateSharp.Grammars.IToken)) + (Theme (: TextMateSharp.Themes.Theme)) + (ThemeRule (: TextMateSharp.Themes.ThemeTrieElementRule)) + (FontStyle (: TextMateSharp.Themes.FontStyle)) + (TimeSpan (: System.TimeSpan)) + (ClrLock (: System.Threading.Lock (-> ClrLock))) + ((GuiColours %k %v) (: System.Collections.ObjectModel.ReadOnlyDictionary)) + ((KeyValuePair %k %v) (: System.Collections.Generic.KeyValuePair)) + (ArgumentException (: System.ArgumentException (-> string ArgumentException)))) + +(import/extern + ;; --- grammars and languages --- + (clr-load-package (: TextMateSharp.Grammars.RegistryOptions.LoadFromLocalFile + (-> RegistryOptions string string bool void))) + (clr-languages (: TextMateSharp.Grammars.RegistryOptions.GetAvailableLanguages + (-> RegistryOptions (System.Collections.Generic.List ClrLanguage)))) + (clr-language-id (: TextMateSharp.Grammars.Language.Id (-> ClrLanguage string) #:get)) + (clr-language-aliases (: TextMateSharp.Grammars.Language.Aliases + (-> ClrLanguage (System.Collections.Generic.List string)) #:get)) + (clr-language-extensions (: TextMateSharp.Grammars.Language.Extensions + (-> ClrLanguage (System.Collections.Generic.List string)) #:get)) + (clr-scope-of (: TextMateSharp.Grammars.RegistryOptions.GetScopeByLanguageId + (-> RegistryOptions string string))) + (clr-load-grammar (: TextMateSharp.Registry.Registry.LoadGrammar (-> Registry string Grammar))) + (clr-registry-theme (: TextMateSharp.Registry.Registry.GetTheme (-> Registry Theme))) + + ;; --- tokenizing --- + (clr-initial-state (: TextMateSharp.Grammars.StateStack.NULL #:get)) + (clr-tokenize (: TextMateSharp.Grammars.IGrammar.TokenizeLine + (-> Grammar LineText StateStack TimeSpan ScopedResult))) + (clr-tokenize-encoded (: TextMateSharp.Grammars.IGrammar.TokenizeLine2 + (-> Grammar LineText StateStack TimeSpan EncodedResult))) + (clr-scoped-tokens (: TextMateSharp.Grammars.ITokenizeLineResult.Tokens (-> ScopedResult (Array Token)) #:get)) + (clr-scoped-state (: TextMateSharp.Grammars.ITokenizeLineResult.RuleStack (-> ScopedResult StateStack) #:get)) + (clr-encoded-tokens (: TextMateSharp.Grammars.ITokenizeLineResult2.Tokens (-> EncodedResult (Array int)) #:get)) + (clr-encoded-state (: TextMateSharp.Grammars.ITokenizeLineResult2.RuleStack (-> EncodedResult StateStack) #:get)) + (clr-token-start (: TextMateSharp.Grammars.IToken.StartIndex (-> Token int) #:get)) + (clr-token-scopes (: TextMateSharp.Grammars.IToken.Scopes + (-> Token (System.Collections.Generic.List string)) #:get)) + (clr-meta-foreground (: TextMateSharp.Internal.Grammars.EncodedTokenAttributes.GetForeground (-> int int))) + (clr-meta-background (: TextMateSharp.Internal.Grammars.EncodedTokenAttributes.GetBackground (-> int int))) + (clr-meta-font-style (: TextMateSharp.Internal.Grammars.EncodedTokenAttributes.GetFontStyle (-> int FontStyle))) + + ;; --- the theme --- + (clr-theme-color (: TextMateSharp.Themes.Theme.GetColor (-> Theme int string))) + (clr-theme-colours (: TextMateSharp.Themes.Theme.GetColorMap + (-> Theme (System.Collections.Generic.ICollection string)))) + (clr-theme-gui (: TextMateSharp.Themes.Theme.GetGuiColorDictionary (-> Theme (GuiColours string string)))) + (clr-theme-match (: TextMateSharp.Themes.Theme.Match + (-> Theme (System.Collections.Generic.IList string) + (System.Collections.Generic.List ThemeRule)))) + (clr-rule-foreground (: TextMateSharp.Themes.ThemeTrieElementRule.foreground (-> ThemeRule int) #:get)) + (clr-rule-background (: TextMateSharp.Themes.ThemeTrieElementRule.background (-> ThemeRule int) #:get)) + (clr-rule-font-style (: TextMateSharp.Themes.ThemeTrieElementRule.fontStyle (-> ThemeRule FontStyle) #:get)) + (clr-rule-parents (: TextMateSharp.Themes.ThemeTrieElementRule.parentScopes + (-> ThemeRule (System.Collections.Generic.List string)) #:get)) + (clr-rule-depth (: TextMateSharp.Themes.ThemeTrieElementRule.scopeDepth (-> ThemeRule int) #:get)) + (clr-has-flag (: System.Enum.HasFlag (-> System.Enum System.Enum bool))) + + ;; --- the rest --- + (clr-substring (: System.String.Substring (-> string int int string))) + (clr-milliseconds (: System.TimeSpan.FromMilliseconds (-> double TimeSpan))) + (clr-lock-enter (: System.Threading.Lock.Enter (-> ClrLock void))) + (clr-lock-exit (: System.Threading.Lock.Exit (-> ClrLock void))) + (clr-full-path (: System.IO.Path.GetFullPath (-> string string))) + (clr-combine (: System.IO.Path.Combine (-> string string string))) + (clr-directory-of (: System.IO.Path.GetDirectoryName (-> string string))) + (clr-file-exists? (: System.IO.File.Exists (-> string bool))) + (clr-directory-exists? (: System.IO.Directory.Exists (-> string bool))) + (null-or-empty? (: System.String.IsNullOrEmpty (-> string bool)))) + +;; An ArgumentException, which is what a mistake in the arguments raises. +(: argument-error (-> string %a)) +(defun (argument-error message) + (raise (cast Exception (ArgumentException. (str "(textmate-bjolang core): " message))))) + +;; --------------------------------------------------------------------------- +;; Themes and styles +;; --------------------------------------------------------------------------- + +;; VS Code's themes, the ones TextMateSharp carries: #:theme 'dark-plus. +(type (: TmTheme (Union (: ThemeDarkPlus #:tag dark-plus) + (: ThemeLightPlus #:tag light-plus) + (: ThemeDark #:tag dark) + (: ThemeLight #:tag light) + (: ThemeMonokai #:tag monokai) + (: ThemeDimmedMonokai #:tag dimmed-monokai) + (: ThemeOneDark #:tag one-dark) + (: ThemeAtomOneDark #:tag atom-one-dark) + (: ThemeAtomOneLight #:tag atom-one-light) + (: ThemeDracula #:tag dracula) + (: ThemeSolarizedDark #:tag solarized-dark) + (: ThemeSolarizedLight #:tag solarized-light) + (: ThemeQuietLight #:tag quiet-light) + (: ThemeKimbieDark #:tag kimbie-dark) + (: ThemeTomorrowNightBlue #:tag tomorrow-night-blue) + (: ThemeAbyss #:tag abyss) + (: ThemeRed #:tag red) + (: ThemeHighContrastDark #:tag high-contrast-dark) + (: ThemeHighContrastLight #:tag high-contrast-light) + (: ThemeVisualStudioDark #:tag visual-studio-dark) + (: ThemeVisualStudioLight #:tag visual-studio-light)))) + +;; How a node is coloured: #:style 'inline or #:style 'classes. +(type (: TmStyleMode (Union (: StyleInline #:tag inline) + (: StyleClasses #:tag classes)))) + +;; How a piece of text looks. None is the theme's own colour, which the pre +;; around the code already has. +(type/derive (Eq) + (: TmStyle (Record (: color (Option string)) + (: background (Option string)) + (: bold bool) + (: italic bool) + (: underline bool) + (: strikethrough bool)))) + +;; A token's text and its scopes, the outermost first: source.cs, then +;; comment.line.double-slash.cs, then punctuation.definition.comment.cs. +(type (: TmToken (Record (: text string) (: scopes (Vec string))))) + +;; A piece of text and how it looks. +(type (: TmSpan (Record (: text string) (: style TmStyle)))) + +(: plain-style TmStyle) +(def plain-style + (TmStyle (color None) (background None) (bold #f) (italic #f) (underline #f) (strikethrough #f))) + +(: theme-name (-> TmTheme ThemeName)) +(defun (theme-name t) + (match t + (ThemeDarkPlus ThemeName.DarkPlus) + (ThemeLightPlus ThemeName.LightPlus) + (ThemeDark ThemeName.Dark) + (ThemeLight ThemeName.Light) + (ThemeMonokai ThemeName.Monokai) + (ThemeDimmedMonokai ThemeName.DimmedMonokai) + (ThemeOneDark ThemeName.OneDark) + (ThemeAtomOneDark ThemeName.AtomOneDark) + (ThemeAtomOneLight ThemeName.AtomOneLight) + (ThemeDracula ThemeName.Dracula) + (ThemeSolarizedDark ThemeName.SolarizedDark) + (ThemeSolarizedLight ThemeName.SolarizedLight) + (ThemeQuietLight ThemeName.QuietLight) + (ThemeKimbieDark ThemeName.KimbieDark) + (ThemeTomorrowNightBlue ThemeName.TomorrowNightBlue) + ;; TextMateSharp spells it so. + (ThemeAbyss ThemeName.Abbys) + (ThemeRed ThemeName.Red) + (ThemeHighContrastDark ThemeName.HighContrastDark) + (ThemeHighContrastLight ThemeName.HighContrastLight) + (ThemeVisualStudioDark ThemeName.VisualStudioDark) + (ThemeVisualStudioLight ThemeName.VisualStudioLight))) + +;; --------------------------------------------------------------------------- +;; Highlighters and languages +;; --------------------------------------------------------------------------- + +;; A language as it may be asked for: its id and aliases, and the extensions +;; of its files, all in lower case. +(type (: LanguageEntry (Record (: id string) (: names (Vec string)) (: extensions (Vec string))))) + +;; The grammars, one theme, and what is worked out from the theme once: its +;; colours by id (id 0 is none) and the editor's own two. The lock is held +;; while TextMateSharp works; see the head of the file. +(type (: TmHighlighter #:opaque + (Record (: options RegistryOptions) + (: registry Registry) + (: theme Theme) + (: colours (Vec string)) + (: foreground string) + (: background string) + (: languages (Vec LanguageEntry)) + (: lock ClrLock) + (: limit TimeSpan)))) + +;; A grammar, which belongs to the highlighter that loaded it: TextMateSharp +;; colours tokens by that highlighter's theme as it reads them. +(type (: TmLanguage #:opaque + (Record (: id string) (: grammar Grammar) (: highlighter TmHighlighter)))) + +(: with-lock (-> TmHighlighter (-> %a) %a)) +(defun (with-lock hl thunk) + (def lock (record-ref hl lock)) + (clr-lock-enter lock) + (try (thunk) #:finally (clr-lock-exit lock))) + +;; This module's DLL is src/core.dll in the package, and the Bjolang grammar +;; is beside src/. The DLL is found from a value of a type declared here, +;; whose class it holds. Nothing when the DLL has no file. +(: bundled-package (-> (Option string))) +(defun (bundled-package) + (def dll (.-Location (.-Assembly (.GetType (cast Object plain-style))))) + (if (null-or-empty? dll) + None + (Some (clr-full-path (clr-combine (clr-directory-of dll) "../grammars/bjolang/package.json"))))) + +;; Adds the grammars of a VS Code extension: its package.json, or the +;; directory it is in. Keyed by the file's path, because TextMateSharp skips a +;; key it has already, and with overwrite on it throws. +(: add-package! (-> RegistryOptions string void)) +(defun (add-package! options path) + (def file (clr-full-path (if (clr-directory-exists? path) (clr-combine path "package.json") path))) + (unless (clr-file-exists? file) + (argument-error (str "there is no grammar package at " file + ": give a VS Code extension's package.json, or the directory it is in."))) + (clr-load-package options file file #f)) + +;; A .NET list of strings, which TextMateSharp leaves null for none, in lower +;; case. +(: lower-strings (-> (System.Collections.Generic.List string) (Vec string))) +(defun (lower-strings xs) + (match (cast Object xs) + ((:is System.Collections.IEnumerable e) + (loop (:for s (cast (Seq string) e)) + (:acc (vecing (string-downcase s))))) + (_ (vec-empty)))) + +(: language-table (-> RegistryOptions (Vec LanguageEntry))) +(defun (language-table options) + (loop (:for l (cast (Seq ClrLanguage) (clr-languages options))) + (:acc (vecing (LanguageEntry (id (clr-language-id l)) + (names (vec-insert (lower-strings (clr-language-aliases l)) 0 + (string-downcase (clr-language-id l)))) + (extensions (lower-strings (clr-language-extensions l)))))))) + +;; The theme's colours by id. TextMateSharp looks one up by walking them all, +;; and a line of code asks for several. +(: colour-table (-> Theme (Vec string))) +(defun (colour-table theme) + (def count (.-Count (clr-theme-colours theme))) + (loop (:for id (range 0 (+ count 1))) + (:acc (vecing (if (= id 0) "" (let ((c (clr-theme-color theme id))) (if (null-or-empty? c) "" c))))))) + +(: gui-colour (-> Theme string (Option string))) +(defun (gui-colour theme key) + (loop (:for kv (cast (Seq (KeyValuePair string string)) (clr-theme-gui theme))) + (:acc found (folding None (if (= (.-Key kv) key) (Some (.-Value kv)) found))))) + +(: colour-at (-> (Vec string) int string)) +(defun (colour-at colours id) + (if (< id (vec-length colours)) (vec-ref colours id) "")) + +;; A highlighter: VS Code's grammars, Bjolang's, the ones in #:grammars — each +;; a VS Code extension's package.json or its directory — and one theme. Built +;; once and used for everything, since reading a grammar is the slow part. +;; #:line-time-limit is how long one line may take, in milliseconds. +(: highlighter (-> (#:theme TmTheme) (#:grammars (List string)) (#:line-time-limit int) TmHighlighter)) +(defun (highlighter #:theme 'dark-plus #:grammars Nil #:line-time-limit 500) + (def options (RegistryOptions. (theme-name theme))) + (match (bundled-package) + ((Some file) (when (clr-file-exists? file) (clr-load-package options file file #f))) + (None unit)) + (list-for-each (fun (path) (add-package! options path)) grammars) + (def registry (Registry. options)) + (def t (clr-registry-theme registry)) + (def colours (colour-table t)) + (TmHighlighter (options options) + (registry registry) + (theme t) + (colours colours) + (foreground (option-value (gui-colour t "editor.foreground") (colour-at colours 1))) + (background (option-value (gui-colour t "editor.background") (colour-at colours 2))) + (languages (language-table options)) + (lock (ClrLock.)) + (limit (clr-milliseconds (cast System.Double line-time-limit))))) + +;; The colour of text the theme says nothing about. +(: highlighter-foreground (-> TmHighlighter string)) +(defun (highlighter-foreground hl) (record-ref hl foreground)) + +(: highlighter-background (-> TmHighlighter string)) +(defun (highlighter-background hl) (record-ref hl background)) + +;; Every language's id. +(: language-names (-> TmHighlighter (Vec string))) +(defun (language-names hl) (vec-map (fun (e) (record-ref e id)) (record-ref hl languages))) + +(: language-id (-> TmLanguage string)) +(defun (language-id lang) (record-ref lang id)) + +(: first-entry (-> (-> LanguageEntry bool) (Vec LanguageEntry) (Option LanguageEntry))) +(defun (first-entry wanted? entries) + (loop (:for e entries) + (:acc found (folding None (if (and (none? found) (wanted? e)) (Some e) found))))) + +(: load-language (-> TmHighlighter string (Option TmLanguage))) +(defun (load-language hl id) + (def scope (clr-scope-of (record-ref hl options) id)) + (if (null-or-empty? scope) + None + (match (cast Object (with-lock hl (fun () (clr-load-grammar (record-ref hl registry) scope)))) + ((:is TextMateSharp.Grammars.IGrammar g) (Some (TmLanguage (id id) (grammar g) (highlighter hl)))) + (_ None)))) + +;; A language by its id, an alias or an extension, in any case: "csharp", +;; "C#", "cs" and ".cs" are one language. A grammar is read the first time +;; its language is asked for, and a broken one raises TextMateSharp's error. +(: find-language (-> TmHighlighter string (Option TmLanguage))) +(defun (find-language hl name) + (def wanted (string-downcase (string-trim name))) + (def dotted (if (string-starts-with? wanted ".") wanted (str "." wanted))) + (def entries (record-ref hl languages)) + (def entry (match (first-entry (fun (e) (vec-contains (record-ref e names) wanted)) entries) + ((Some e) (Some e)) + (None (first-entry (fun (e) (vec-contains (record-ref e extensions) dotted)) entries)))) + (match entry + ((Some e) (load-language hl (record-ref e id))) + (None None))) + +;; --------------------------------------------------------------------------- +;; Tokens and spans +;; --------------------------------------------------------------------------- + +;; The lines of some code. \r\n, \r and \n all end one, and a newline at the +;; very end ends the last line rather than beginning an empty one. +(: lines-of (-> string (Vec string))) +(defun (lines-of code) + (def unified (string-replace (string-replace code "\r\n" "\n") "\r" "\n")) + (cond + ((string-empty? unified) (vec-empty)) + ((string-ends-with? unified "\n") + (string-split (clr-substring unified 0 (- (string-length unified) 1)) "\n")) + (else (string-split unified "\n")))) + +;; Where each token's text lies in its line, as (index from to): from its +;; start to the next one's, the last to the end. TextMateSharp reads the line +;; with a newline added, so a start can lie past the text; and the first +;; token starts at 0, whatever it says. A token left with no text is dropped. +(: token-bounds (-> int int (-> int int) (Vec (Tuple int int int)))) +(defun (token-bounds count len start-of) + (loop (:for i (range 0 count)) + (:acc out (folding (vec-empty) + (let ((from (if (= i 0) 0 (min (start-of i) len))) + (to (if (< (+ i 1) count) (min (start-of (+ i 1)) len) len))) + (if (< from to) (vec-add out (Tuple i from to)) out)))))) + +(: scopes-of (-> Token (Vec string))) +(defun (scopes-of t) + (loop (:for s (cast (Seq string) (clr-token-scopes t))) + (:acc (vecing s)))) + +(: scoped-line (-> string (Array Token) (Vec TmToken))) +(defun (scoped-line line tokens) + (vec-map (fun (b) + (match b + ((Tuple i from to) + (TmToken (text (clr-substring line from (- to from))) + (scopes (scopes-of (array-ref tokens i))))))) + (token-bounds (array-length tokens) (string-length line) + (fun (i) (clr-token-start (array-ref tokens i)))))) + +;; Each line of some code, as tokens and their scopes. Needs no theme. +(: tokenize (-> TmLanguage string (Vec (Vec TmToken)))) +(defun (tokenize lang code) + (def hl (record-ref lang highlighter)) + (def g (record-ref lang grammar)) + (def limit (record-ref hl limit)) + (def lines (lines-of code)) + (with-lock hl + (fun () + (match (loop (:for line lines) + (:acc acc (folding (Tuple (cast StateStack clr-initial-state) (vec-empty)) + (match acc + ((Tuple state out) + (let ((r (clr-tokenize g (LineText. line) state limit))) + (Tuple (clr-scoped-state r) + (vec-add out (scoped-line line (clr-scoped-tokens r)))))))))) + ((Tuple _ out) out))))) + +(: has-font-style? (-> FontStyle FontStyle bool)) +(defun (has-font-style? fs flag) + ;; NotSet is -1, every flag at once. + (and (not (clr-has-flag (cast System.Enum fs) (cast System.Enum FontStyle.NotSet))) + (clr-has-flag (cast System.Enum fs) (cast System.Enum flag)))) + +;; A colour id as a colour, or None for the theme's own: the id the theme +;; gives its default, or the colour the editor has, which the pre has too. +;; The default is its own id — 1 for text, 2 for background — and is what the +;; theme's token colours say, which is black and white when, as in Dark+, +;; they say nothing and the editor's colours are meant. +(: colour-or-none (-> TmHighlighter int int string (Option string))) +(defun (colour-or-none hl id default-id editor) + (def c (colour-at (record-ref hl colours) id)) + (if (or (<= id 0) (= id default-id) (string-empty? c) (= (string-downcase c) (string-downcase editor))) + None + (Some c))) + +(: style-of (-> TmHighlighter int TmStyle)) +(defun (style-of hl metadata) + (def fs (clr-meta-font-style metadata)) + (TmStyle (color (colour-or-none hl (clr-meta-foreground metadata) 1 (record-ref hl foreground))) + (background (colour-or-none hl (clr-meta-background metadata) 2 (record-ref hl background))) + (bold (has-font-style? fs FontStyle.Bold)) + (italic (has-font-style? fs FontStyle.Italic)) + (underline (has-font-style? fs FontStyle.Underline)) + (strikethrough (has-font-style? fs FontStyle.Strikethrough)))) + +;; Whitespace looks the same in any colour, so it is plain unless something +;; would show on it: a background, or a line under or through it. +(: plain-whitespace (-> TmSpan TmSpan)) +(defun (plain-whitespace s) + (def style (record-ref s style)) + (if (and (string-empty? (string-trim (record-ref s text))) + (none? (record-ref style background)) + (not (record-ref style underline)) + (not (record-ref style strikethrough))) + (TmSpan (text (record-ref s text)) (style plain-style)) + s)) + +;; Neighbours that look the same are one span. +(: merge-spans (-> (Vec TmSpan) (Vec TmSpan))) +(defun (merge-spans spans) + (loop (:for s spans) + (:acc out (folding (vec-empty) + (let ((last (- (vec-length out) 1))) + (if (and (>= last 0) (= (record-ref (vec-ref out last) style) (record-ref s style))) + (vec-set out last (TmSpan (text (str (record-ref (vec-ref out last) text) (record-ref s text))) + (style (record-ref s style)))) + (vec-add out s))))))) + +(: styled-line (-> TmHighlighter string (Array int) (Vec TmSpan))) +(defun (styled-line hl line encoded) + ;; Pairs: a token's start, then its metadata. + (merge-spans + (vec-map (fun (b) + (match b + ((Tuple i from to) + (plain-whitespace + (TmSpan (text (clr-substring line from (- to from))) + (style (style-of hl (array-ref encoded (+ (* 2 i) 1))))))))) + (token-bounds (/ (array-length encoded) 2) (string-length line) + (fun (i) (array-ref encoded (* 2 i))))))) + +;; Each line of some code, as spans coloured by the highlighter's theme. +(: highlight (-> TmLanguage string (Vec (Vec TmSpan)))) +(defun (highlight lang code) + (def hl (record-ref lang highlighter)) + (def g (record-ref lang grammar)) + (def limit (record-ref hl limit)) + (def lines (lines-of code)) + (with-lock hl + (fun () + (match (loop (:for line lines) + (:acc acc (folding (Tuple (cast StateStack clr-initial-state) (vec-empty)) + (match acc + ((Tuple state out) + (let ((r (clr-tokenize-encoded g (LineText. line) state limit))) + (Tuple (clr-encoded-state r) + (vec-add out (styled-line hl line (clr-encoded-tokens r)))))))))) + ((Tuple _ out) out))))) + +;; --------------------------------------------------------------------------- +;; Classes +;; --------------------------------------------------------------------------- + +;; The scopes a class is made from, TextMate's conventional names, the +;; general before the particular: that is the order of the stylesheet, so +;; that tm-keyword-control, written after tm-keyword, wins over it. +(: class-scopes (List string)) +(def class-scopes + (list "comment" "constant" "entity" "invalid" "keyword" "markup" "punctuation" "storage" "string" + "support" "variable" + "constant.numeric" "constant.character" "constant.language" "constant.other" + "entity.name" "entity.other" + "invalid.illegal" "invalid.deprecated" + "keyword.control" "keyword.operator" "keyword.other" + "markup.bold" "markup.italic" "markup.underline" "markup.heading" "markup.list" "markup.quote" + "markup.raw" "markup.inserted" "markup.deleted" "markup.changed" + "storage.type" "storage.modifier" + "string.regexp" + "support.function" "support.class" "support.type" "support.constant" "support.variable" + "variable.parameter" "variable.language" "variable.other" + "comment.block.documentation" "constant.character.escape" + "entity.name.function" "entity.name.type" "entity.name.tag" "entity.name.section" + "entity.name.variable" "entity.other.inherited-class" "entity.other.attribute-name" + "punctuation.section.embedded")) + +(: class-vocabulary (Set string)) +(def class-vocabulary (list->set class-scopes)) + +;; The class scope a grammar scope comes under: the longest one it begins +;; with, a whole segment at a time. None for a scope that says nothing about +;; how text looks — meta., source. — and for punctuation.definition, the +;; quotes of a string and the ; of a comment, which look like what they +;; delimit. +(: vocabulary-entry (-> string (Option string))) +(defun (vocabulary-entry scope) + (if (string-starts-with? scope "punctuation.definition.") + None + (let ((segments (string-split scope "."))) + (loop (:for k (range 1 (+ (min 3 (vec-length segments)) 1))) + (:acc found (folding None + (let ((prefix (string-join (vec-slice segments 0 k) "."))) + (if (set-contains? class-vocabulary prefix) (Some prefix) found)))))))) + +(: class-name (-> string string)) +(defun (class-name scope) (str "tm-" (string-replace scope "." "-"))) + +;; Where the code of one language begins inside another's text: the hole of +;; an interpolated string, a script in HTML. What is outside does not colour +;; what is inside. +(: embedded-scope? (-> string bool)) +(defun (embedded-scope? scope) + (or (string-starts-with? scope "meta.embedded") + (string-starts-with? scope "source.") + (string-starts-with? scope "text."))) + +;; A token's classes: the general one and the particular, "tm-keyword +;; tm-keyword-control", from the innermost scope that has one, looking no +;; further out than where embedded code begins. That is how a theme picks a +;; token's colour too. None for plain text. +(: token-classes (-> TmToken (Vec string))) +(defun (token-classes t) + (def scopes (record-ref t scopes)) + (def entry (loop (:for i (range 0 (vec-length scopes))) + (:acc found (folding None + (let ((scope (vec-ref scopes i))) + (if (embedded-scope? scope) + None + (match (vocabulary-entry scope) + ((Some e) (Some e)) + (None found)))))))) + (match entry + ((Some e) + (let ((top (vec-ref (string-split e ".") 0))) + (if (= top e) [(class-name e)] [(class-name top) (class-name e)]))) + (None (vec-empty)))) + +;; A rule with a selector, which applies whatever surrounds the scope. A +;; rule of no depth is the theme saying nothing, and is passed over. +(: unconditional? (-> ThemeRule bool)) +(defun (unconditional? r) + (and (> (clr-rule-depth r) 0) + (match (cast Object (clr-rule-parents r)) + ((:is System.Collections.ICollection c) (= (.-Count c) 0)) + (_ #t)))) + +;; How a theme styles a class scope, as CSS. The rule is the one +;; TextMateSharp colours a token of that scope by: the first that applies, +;; whole. That is the theme's own before the one it includes, however +;; specific the included one is. A font style that is set is written in +;; full, so that "none" undoes a general class's italic. +(: theme-css (-> TmHighlighter string string)) +(defun (theme-css hl scope) + (def rule (loop (:for r (cast (Seq ThemeRule) + (clr-theme-match (record-ref hl theme) + (cast (System.Collections.Generic.IList string) #[scope])))) + (:acc found (folding None (if (and (none? found) (unconditional? r)) (Some r) found))))) + (def fg (match rule ((Some r) (clr-rule-foreground r)) (None 0))) + (def bg (match rule ((Some r) (if (> (clr-rule-background r) 2) (clr-rule-background r) 0)) (None 0))) + (def fs (match rule + ((Some r) (if (clr-has-flag (cast System.Enum (clr-rule-font-style r)) (cast System.Enum FontStyle.NotSet)) + None + (Some (clr-rule-font-style r)))) + (None None))) + (def colours (record-ref hl colours)) + (def parts + (vec-merge + (vec-merge (cond ((= fg 0) (vec-empty)) + ;; The theme's default is the editor's colour, as it is inline. + ((= fg 1) [(str "color:" (record-ref hl foreground))]) + (else [(str "color:" (colour-at colours fg))])) + (if (= bg 0) (vec-empty) [(str "background-color:" (colour-at colours bg))])) + (match fs + ((Some s) + (def decorations (vec-merge (if (has-font-style? s FontStyle.Underline) ["underline"] (vec-empty)) + (if (has-font-style? s FontStyle.Strikethrough) ["line-through"] (vec-empty)))) + [(str "font-weight:" (if (has-font-style? s FontStyle.Bold) "bold" "normal")) + (str "font-style:" (if (has-font-style? s FontStyle.Italic) "italic" "normal")) + (str "text-decoration:" (if (vec-empty? decorations) "none" (string-join decorations " ")))]) + (None (vec-empty))))) + (string-join parts ";")) + +;; A stylesheet for #:style 'classes in this highlighter's theme, every rule +;; under #:selector: the pre's colours, then a rule for each class the theme +;; has something to say about. +(: highlighter-css (-> TmHighlighter (#:selector string) string)) +(defun (highlighter-css hl #:selector ".tm") + (def rules (loop (:for scope class-scopes) + (:acc out (folding (vec-empty) + (let ((css (theme-css hl scope))) + (if (string-empty? css) + out + (vec-add out (str selector " ." (class-name scope) "{" css "}")))))))) + (string-join (vec-insert rules 0 (str selector "{color:" (record-ref hl foreground) + ";background-color:" (record-ref hl background) "}")) + "\n")) + +;; --------------------------------------------------------------------------- +;; Nodes +;; --------------------------------------------------------------------------- + +(: pre-tag XmlName) +(def pre-tag (xml-name "pre")) + +(: code-tag XmlName) +(def code-tag (xml-name "code")) + +(: span-tag XmlName) +(def span-tag (xml-name "span")) + +(: class-attr XmlName) +(def class-attr (xml-name "class")) + +(: style-attr XmlName) +(def style-attr (xml-name "style")) + +(: style->css (-> TmStyle string)) +(defun (style->css s) + (def decorations (vec-merge (if (record-ref s underline) ["underline"] (vec-empty)) + (if (record-ref s strikethrough) ["line-through"] (vec-empty)))) + (string-join + (vec-merge + (vec-merge (match (record-ref s color) ((Some c) [(str "color:" c)]) (None (vec-empty))) + (match (record-ref s background) ((Some c) [(str "background-color:" c)]) (None (vec-empty)))) + (vec-merge (vec-merge (if (record-ref s bold) ["font-weight:bold"] (vec-empty)) + (if (record-ref s italic) ["font-style:italic"] (vec-empty))) + (if (vec-empty? decorations) (vec-empty) [(str "text-decoration:" (string-join decorations " "))]))) + ";")) + +;; Text in a span with that attribute, or the text alone when it is "". +(: span-node (-> XmlName string string Node)) +(defun (span-node attr value text) + (if (string-empty? value) + (xml-text text) + (xml-element span-tag (list (Tuple attr value)) (list (xml-text text))))) + +(: inline-line (-> (Vec TmSpan) (Vec Node))) +(defun (inline-line spans) + (vec-map (fun (s) (span-node style-attr (style->css (record-ref s style)) (record-ref s text))) spans)) + +;; Neighbours with the same classes are one span. +(: class-line (-> (Vec TmToken) (Vec Node))) +(defun (class-line tokens) + (def runs (loop (:for t tokens) + (:acc out (folding (vec-empty) + (let ((classes (string-join (token-classes t) " ")) + (last (- (vec-length out) 1))) + (match (if (>= last 0) (Some (vec-ref out last)) None) + ((Some (Tuple c text)) + (if (= c classes) + (vec-set out last (Tuple c (str text (record-ref t text)))) + (vec-add out (Tuple classes (record-ref t text))))) + (None (vec-add out (Tuple classes (record-ref t text)))))))))) + (vec-map (fun (run) (match run ((Tuple classes text) (span-node class-attr classes text)))) runs)) + +;; The lines as the code element's children, with a newline between each. +;; Under #:lines? each line is a (span (@ (class "line")) ...), with its +;; newline inside it, so that no line but perhaps the last is empty. +(: assemble (-> (Vec (Vec Node)) bool (List Node))) +(defun (assemble lines lines?) + (def count (vec-length lines)) + (vec->list + (loop (:for i (range 0 count)) + (:acc out (folding (vec-empty) + (let* ((nodes (vec-ref lines i)) + (content (if (< (+ i 1) count) (vec-add nodes (xml-text "\n")) nodes))) + (if lines? + (vec-add out (xml-element span-tag (list (Tuple class-attr "line")) (vec->list content))) + (vec-merge out content)))))))) + +;; The pre and code elements around some children: the pre carries the +;; theme's colours when they are inline, and the code the language, as +;; language-csharp. +(: pre-node (-> TmHighlighter TmStyleMode (Option string) (List Node) Node)) +(defun (pre-node hl style language children) + (def pre-attrs + (match style + (StyleInline (list (Tuple class-attr "tm") + (Tuple style-attr (str "color:" (record-ref hl foreground) + ";background-color:" (record-ref hl background))))) + (StyleClasses (list (Tuple class-attr "tm"))))) + (def code-attrs (match language + ((Some id) (list (Tuple class-attr (str "language-" id)))) + (None Nil))) + (xml-element pre-tag pre-attrs (list (xml-element code-tag code-attrs children)))) + +;; Some code, highlighted, as the children of a code element. +(: highlight->nodes (-> TmLanguage string (#:style TmStyleMode) (#:lines? bool) (List Node))) +(defun (highlight->nodes lang code #:style 'inline #:lines? #f) + (assemble (match style + (StyleInline (vec-map inline-line (highlight lang code))) + (StyleClasses (vec-map class-line (tokenize lang code)))) + lines?)) + +;; Some code, highlighted, in a pre and a code element. +(: highlight->node (-> TmLanguage string (#:style TmStyleMode) (#:lines? bool) Node)) +(defun (highlight->node lang code #:style 'inline #:lines? #f) + (pre-node (record-ref lang highlighter) style (Some (record-ref lang id)) + (highlight->nodes lang code #:style style #:lines? lines?))) + +;; Some code in a language named as a Markdown fence names it — "c#", or +;; "scheme title=x", of which the first word counts — highlighted when the +;; language is known and as plain text when it is not. +(: code->node (-> TmHighlighter string string (#:style TmStyleMode) (#:lines? bool) Node)) +(defun (code->node hl name code #:style 'inline #:lines? #f) + (def word (vec-ref (string-split (string-trim name) " ") 0)) + (match (find-language hl word) + ((Some lang) (highlight->node lang code #:style style #:lines? lines?)) + (None (pre-node hl style (if (string-empty? word) None (Some word)) + (assemble (vec-map (fun (line) [(xml-text line)]) (lines-of code)) lines?))))) diff --git a/tests/demo.bjo b/tests/demo.bjo new file mode 100644 index 0000000..aeaa88b --- /dev/null +++ b/tests/demo.bjo @@ -0,0 +1,181 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +;; textmate-bjolang/tests/demo.bjo — languages, tokens, spans, classes and +;; nodes, in Dark+. +;; +;; bjo run tests/demo.bjo + +(import (std prelude)) +(import (std simpletest)) +(import (text xml)) +(import (textmate-bjolang core)) + +(import/extern + (clr-index-of (: System.String.IndexOf (-> string string System.StringComparison int))) + (clr-ordinal (: System.StringComparison.Ordinal #:get))) + +(: string-index-of (-> string string int)) +(defun (string-index-of s needle) (clr-index-of s needle clr-ordinal)) + +(: language (-> TmHighlighter string TmLanguage)) +(defun (language hl name) + (match (find-language hl name) + ((Some l) l) + (None (panic! (str "no language " name))))) + +(: texts (-> (Vec TmToken) (Vec string))) +(defun (texts tokens) (vec-map (fun (t) (record-ref t text)) tokens)) + +(: innermost (-> TmToken string)) +(defun (innermost t) + (def scopes (record-ref t scopes)) + (vec-ref scopes (- (vec-length scopes) 1))) + +;; The classes of the first token whose text is `text`, in the first line. +(: classes-of (-> TmLanguage string string string)) +(defun (classes-of lang code text) + (loop (:for t (vec-ref (tokenize lang code) 0)) + (:acc found (folding "(no such token)" + (if (and (= found "(no such token)") (= (record-ref t text) text)) + (string-join (token-classes t) " ") + found))))) + +(: scope (-> string (Vec string) TmToken)) +(defun (scope text scopes) (TmToken (text text) (scopes scopes))) + +(defun (main args) + (def hl (highlighter #:theme 'dark-plus)) + (def cs (language hl "csharp")) + (def bjo (language hl "bjolang")) + (def line "var x = 1; // hi") + + ;; --- languages -------------------------------------------------------------- + (expect "a language by id, alias and extension, in any case, and none for the unknown" + (vec-map (fun (n) (match (find-language hl n) ((Some l) (language-id l)) (None "-"))) + ["csharp" "C#" "cs" ".CS" "bjo" ".bjo" "Bjolang" "klingon" ""]) + ["csharp" "csharp" "csharp" "csharp" "bjolang" "bjolang" "bjolang" "-" "-"]) + (expect-true "VS Code's languages, and Bjolang's from beside the package's src/" + (and (vec-contains (language-names hl) "bjolang") + (vec-contains (language-names hl) "fsharp") + (> (vec-length (language-names hl)) 60))) + (expect "a grammar package that is not there is refused" + (match (try (highlighter #:grammars (list "/nonexistent/grammar")) #:catch (System.ArgumentException)) + ((Ok _) "accepted") + ((Err _) "refused")) + "refused") + + ;; --- tokens ----------------------------------------------------------------- + (def tokens (vec-ref (tokenize cs line) 0)) + (expect "a line's tokens cover its text" + (texts tokens) + ["var" " " "x" " " "=" " " "1" ";" " " "//" " hi"]) + (expect "each has its scopes, the outermost first" + (record-ref (vec-ref tokens 9) scopes) + ["source.cs" "comment.line.double-slash.cs" "punctuation.definition.comment.cs"]) + (expect "a comment's state is carried to the next line" + (innermost (vec-ref (vec-ref (tokenize cs "/* a\n b */ int y;") 1) 0)) + "comment.block.cs") + (expect "\\r\\n, \\r and \\n end lines, and a newline at the end starts none" + (vec-map (fun (code) (vec-length (tokenize cs code))) ["a\r\nb\rc\n" "" "\n" "a\n\n"]) + [3 0 1 2]) + + ;; --- spans ------------------------------------------------------------------ + (def spans (vec-ref (highlight cs line) 0)) + (expect "spans that look alike are joined, whitespace and the default colour are plain" + (vec-map (fun (s) (record-ref s text)) spans) + ["var" " " "x" " = " "1" "; " "// hi"]) + (expect "colours are the theme's, and None where the pre's colour will do" + (vec-map (fun (s) (option-value (record-ref (record-ref s style) color) "-")) spans) + ["#569CD6" "-" "#9CDCFE" "-" "#B5CEA8" "-" "#6A9955"]) + (expect "the editor's colours" + (Tuple (highlighter-foreground hl) (highlighter-background hl)) + (Tuple "#D4D4D4" "#1E1E1E")) + + ;; --- classes ---------------------------------------------------------------- + (expect "a class is the innermost scope the vocabulary knows, the general and the particular" + (vec-map (fun (t) (string-join (token-classes t) " ")) + [(scope "var" ["source.cs" "storage.type.var.cs"]) + (scope "f" ["source.bjolang" "entity.name.function.member.bjolang"]) + (scope "if" ["source.x" "meta.block.x" "keyword.control.x"]) + (scope "{" ["source.x" "meta.block.x"])]) + ["tm-storage tm-storage-type" "tm-entity tm-entity-name-function" "tm-keyword tm-keyword-control" ""]) + (expect "a string's quotes and a comment's marker are the string and the comment" + (vec-map (fun (t) (string-join (token-classes t) " ")) + [(scope "\"" ["source.cs" "string.quoted.double.cs" "punctuation.definition.string.begin.cs"]) + (scope "//" ["source.cs" "comment.line.double-slash.cs" "punctuation.definition.comment.cs"])]) + ["tm-string" "tm-comment"]) + (expect "embedded code is not coloured by what it is embedded in" + (string-join (token-classes (scope "x" ["source.bjolang" "string.interpolated.bjolang" + "meta.embedded.line.bjolang" "source.bjolang"])) + " ") + "") + + ;; --- nodes ------------------------------------------------------------------ + (expect "inline: the theme's colours in style attributes" + (->str (highlight->node cs line)) + (str "(pre (@ (class \"tm\") (style \"color:#D4D4D4;background-color:#1E1E1E\"))" + " (code (@ (class \"language-csharp\"))" + " (span (@ (style \"color:#569CD6\")) \"var\") \" \" (span (@ (style \"color:#9CDCFE\")) \"x\")" + " \" = \" (span (@ (style \"color:#B5CEA8\")) \"1\") \"; \" (span (@ (style \"color:#6A9955\")) \"// hi\")))")) + (expect "classes: the scopes' names, and no theme" + (->str (highlight->node cs line #:style 'classes)) + (str "(pre (@ (class \"tm\")) (code (@ (class \"language-csharp\"))" + " (span (@ (class \"tm-storage tm-storage-type\")) \"var\") \" \"" + " (span (@ (class \"tm-entity tm-entity-name-variable\")) \"x\") \" \"" + " (span (@ (class \"tm-keyword tm-keyword-operator\")) \"=\") \" \"" + " (span (@ (class \"tm-constant tm-constant-numeric\")) \"1\")" + " (span (@ (class \"tm-punctuation\")) \";\") \" \" (span (@ (class \"tm-comment\")) \"// hi\")))")) + (expect "lines, each a span with its newline inside, and an unknown language as plain text" + (->str (code->node hl "klingon" "one\n\nthree" #:style 'classes #:lines? #t)) + (str "(pre (@ (class \"tm\")) (code (@ (class \"language-klingon\"))" + " (span (@ (class \"line\")) \"one\\n\") (span (@ (class \"line\")) \"\\n\")" + " (span (@ (class \"line\")) \"three\")))")) + (expect "a Markdown info string's first word names the language" + (->str (code->node hl "C# title=x" "1")) + (str "(pre (@ (class \"tm\") (style \"color:#D4D4D4;background-color:#1E1E1E\"))" + " (code (@ (class \"language-csharp\")) (span (@ (style \"color:#B5CEA8\")) \"1\")))")) + (expect "several lines, a newline between them" + (->str (highlight->nodes cs "1\n2" #:style 'classes)) + (str "'((span (@ (class \"tm-constant tm-constant-numeric\")) \"1\") \"\\n\"" + " (span (@ (class \"tm-constant tm-constant-numeric\")) \"2\"))")) + + ;; --- the stylesheet --------------------------------------------------------- + (def css (highlighter-css hl)) + (expect-true "the stylesheet starts with the pre's colours" + (string-starts-with? css ".tm{color:#D4D4D4;background-color:#1E1E1E}\n")) + (expect-true "and has the theme's colour for each class it colours" + (and (string-contains? css ".tm .tm-comment{color:#6A9955}") + (string-contains? css ".tm .tm-keyword-control{color:#C586C0}") + (string-contains? css ".tm .tm-string{color:#CE9178}") + (string-contains? css ".tm .tm-storage-type{color:#569CD6}"))) + (expect-true "the rule is the one TextMateSharp colours by: the theme's own before the one it includes" + (string-contains? (highlighter-css (highlighter #:theme 'light-plus)) + ".tm .tm-variable-language{color:#001080}")) + (expect-true "the general class comes before the particular" + (match (Tuple (string-index-of css ".tm .tm-keyword{") (string-index-of css ".tm .tm-keyword-control{")) + ((Tuple a b) (and (>= a 0) (< a b))))) + (expect-true "under a selector of one's own" + (string-starts-with? (highlighter-css hl #:selector "pre.dark") "pre.dark{")) + (expect "another theme, other colours" + (let ((light (highlighter #:theme 'light-plus))) + (Tuple (highlighter-foreground light) (highlighter-background light))) + (Tuple "#000000" "#FFFFFF")) + + ;; --- Bjolang ---------------------------------------------------------------- + (def src "(defun (greet name #:loud #f) #\"hi ${name}\" 'sym) ; ok") + (expect "Bjolang: a definition, its name, a keyword, a boolean, a symbol and a comment" + (vec-map (fun (text) (classes-of bjo src text)) ["defun" "greet" "#:loud" "#f" "'sym" " ok"]) + ["tm-storage tm-storage-type" "tm-entity tm-entity-name-function" "tm-variable tm-variable-parameter" + "tm-constant tm-constant-language" "tm-constant tm-constant-language" "tm-comment"]) + (expect "Bjolang: an interpolated string, its hole, and the code inside it" + (vec-map (fun (text) (classes-of bjo src text)) ["#\"" "hi " "${" "name" "}"]) + ["tm-string" "tm-string" "tm-punctuation tm-punctuation-section-embedded" "" + "tm-punctuation tm-punctuation-section-embedded"]) + (expect "Bjolang: a string runs over lines" + (innermost (vec-ref (vec-ref (tokenize bjo "(f \"one\ntwo\" x)") 1) 0)) + "string.quoted.double.bjolang") + + (println "textmate-bjolang ok") + 0)