textmate-bjolang: code highlighted as VS Code does, as Bjolang values

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 <git@eca.dev>
This commit is contained in:
Linus Björnstam 2026-09-30 15:51:24 +02:00
commit 0ecc65e134
10 changed files with 2012 additions and 0 deletions

7
.gitignore vendored Normal file
View file

@ -0,0 +1,7 @@
.bjo/
*.dll
*.exe
*.pdb
*.bjobuild
*.runtimeconfig.json
*.deps.json

373
LICENSE Normal file
View file

@ -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.

168
Readme.org Normal file
View file

@ -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.

View file

@ -0,0 +1,23 @@
{
"comments": {
"lineComment": ";"
},
"brackets": [
["(", ")"],
["[", "]"],
["{", "}"]
],
"autoClosingPairs": [
{ "open": "(", "close": ")" },
{ "open": "[", "close": "]" },
{ "open": "{", "close": "}" },
{ "open": "\"", "close": "\"", "notIn": ["string", "comment"] }
],
"surroundingPairs": [
["(", ")"],
["[", "]"],
["{", "}"],
["\"", "\""]
],
"wordPattern": "[^\\s()\\[\\]{},:\"';]+"
}

View file

@ -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"
}
]
}
}

View file

@ -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": "(?<![^\\s()\\[\\]{},:\"';])#\\\\(?:[^\\s()\\[\\]{},:\"';]{2,}|.)",
"name": "constant.character.bjolang"
},
"boolean": {
"match": "(?<![^\\s()\\[\\]{},:\"';])#[tf](?![^\\s()\\[\\]{},:\"';])",
"name": "constant.language.boolean.bjolang"
},
"escape": {
"patterns": [
{
"match": "\\\\[ntr\"\\\\]",
"name": "constant.character.escape.bjolang"
},
{
"comment": "An escape Bjolang does not define keeps both characters.",
"match": "\\\\."
}
]
},
"string": {
"begin": "\"",
"beginCaptures": {
"0": {
"name": "punctuation.definition.string.begin.bjolang"
}
},
"end": "\"",
"endCaptures": {
"0": {
"name": "punctuation.definition.string.end.bjolang"
}
},
"name": "string.quoted.double.bjolang",
"patterns": [
{
"include": "#escape"
}
]
},
"interpolated-string": {
"comment": "#\"a ${x} b\": a hole is any expression, interpolated strings and braces included.",
"begin": "(?<![^\\s()\\[\\]{},:\"';])#\"",
"beginCaptures": {
"0": {
"name": "punctuation.definition.string.begin.bjolang"
}
},
"end": "\"",
"endCaptures": {
"0": {
"name": "punctuation.definition.string.end.bjolang"
}
},
"name": "string.interpolated.bjolang",
"patterns": [
{
"match": "\\\\\\$",
"name": "constant.character.escape.bjolang"
},
{
"include": "#escape"
},
{
"begin": "\\$\\{",
"beginCaptures": {
"0": {
"name": "punctuation.section.embedded.begin.bjolang"
}
},
"end": "\\}",
"endCaptures": {
"0": {
"name": "punctuation.section.embedded.end.bjolang"
}
},
"name": "meta.embedded.line.bjolang",
"contentName": "source.bjolang",
"patterns": [
{
"include": "#forms"
}
]
}
]
},
"hash-forms": {
"patterns": [
{
"comment": "#[1 2 3], an array, and #(...).",
"match": "(?<![^\\s()\\[\\]{},:\"';])#[\\[(]",
"name": "punctuation.section.array.begin.bjolang"
},
{
"comment": "#'(template), a syntax quote.",
"match": "(?<![^\\s()\\[\\]{},:\"';])#'",
"name": "keyword.operator.quote.bjolang"
},
{
"comment": "#name( and #name[, a hash macro. #t( and #f( are booleans, which come first.",
"match": "(?<![^\\s()\\[\\]{},:\"';])#[^\\s()\\[\\]{},:\"';]+(?=[\\[(])",
"name": "entity.name.function.macro.bjolang"
}
]
},
"signature": {
"comment": "(: name type). The colon alone, which is not a :keyword.",
"patterns": [
{
"match": "(?<=\\()(:)\\s+([A-Z][^\\s()\\[\\]{},:\"';]*)",
"captures": {
"1": {
"name": "keyword.other.signature.bjolang"
},
"2": {
"name": "entity.name.type.bjolang"
}
}
},
{
"match": "(?<=\\()(:)\\s+([^\\s()\\[\\]{},:\"';]+)",
"captures": {
"1": {
"name": "keyword.other.signature.bjolang"
},
"2": {
"name": "entity.name.function.bjolang"
}
}
},
{
"match": "(?<=\\()(:)(?=\\s|\\()",
"captures": {
"1": {
"name": "keyword.other.signature.bjolang"
}
}
}
]
},
"definition": {
"patterns": [
{
"comment": "(defun (name args) ...): the name is inside the parameter list.",
"match": "(?<=\\()(def/pattern|defbjouble|def/macro|defbjo|defun)(?![^\\s()\\[\\]{},:\"';])(?:\\s*(\\()\\s*([^\\s()\\[\\]{},:\"';]+))?",
"captures": {
"1": {
"name": "storage.type.function.bjolang"
},
"2": {
"name": "punctuation.section.parens.begin.bjolang"
},
"3": {
"name": "entity.name.function.bjolang"
}
}
},
{
"comment": "(def/trait (Name %a) ...), (impl (Trait Type) ...).",
"match": "(?<=\\()(impl/extern|type/derive|def/trait|impl)(?![^\\s()\\[\\]{},:\"';])(?:\\s*(\\()\\s*([^\\s()\\[\\]{},:\"';]+))?",
"captures": {
"1": {
"name": "storage.type.bjolang"
},
"2": {
"name": "punctuation.section.parens.begin.bjolang"
},
"3": {
"name": "entity.name.type.bjolang"
}
}
},
{
"comment": "(def name value). A def whose pattern is a list names nothing here.",
"match": "(?<=\\()(def/mutable|def)(?![^\\s()\\[\\]{},:\"';])(?:\\s+([^\\s()\\[\\]{},:\"';]+))?",
"captures": {
"1": {
"name": "storage.type.bjolang"
},
"2": {
"name": "entity.name.variable.bjolang"
}
}
},
{
"match": "(?<=\\()(def/json-type|type-rec|def\\*|type)(?![^\\s()\\[\\]{},:\"';])",
"captures": {
"1": {
"name": "storage.type.bjolang"
}
}
}
]
},
"special-form": {
"patterns": [
{
"match": "(?<=\\()(import/extern|import/class|prefix-types|postfix-defs|prefix-defs|re-export|include|postfix|import|export|except|rename|prefix|only)(?![^\\s()\\[\\]{},:\"';])",
"captures": {
"1": {
"name": "keyword.control.import.bjolang"
}
}
},
{
"match": "(?<=\\()(spawn/detached|parameterize\\*|with-deadline|with-response|parameterize|syntax-match|syntax-quote|spawn/daemon|with-return|with-cancel|with-shield|record-set!|struct-set!|task->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": "(?<![^\\s()\\[\\]{},:\"';])(?:->|-bjo->|-\\?->|=>)(?![^\\s()\\[\\]{},:\"';])",
"name": "storage.type.function.arrow.bjolang"
},
"member": {
"patterns": [
{
"match": "(?<![^\\s()\\[\\]{},:\"';])\\.\\.\\.(?![^\\s()\\[\\]{},:\"';])",
"name": "keyword.operator.spread.bjolang"
},
{
"comment": ".-Length, a .NET property or field.",
"match": "(?<![^\\s()\\[\\]{},:\"';])\\.-[^\\s()\\[\\]{},:\"';]+",
"name": "variable.other.property.bjolang"
},
{
"comment": ".Write, a .NET method.",
"match": "(?<![^\\s()\\[\\]{},:\"';])\\.[^\\s()\\[\\]{},:\\\"';.\\d][^\\s()\\[\\]{},:\"';]*",
"name": "entity.name.function.member.bjolang"
}
]
},
"number": {
"match": "(?<![^\\s()\\[\\]{},:\"';])-?\\d[\\w.\\-]*",
"name": "constant.numeric.bjolang"
},
"type-variable": {
"match": "(?<![^\\s()\\[\\]{},:\"';])%[^\\s()\\[\\]{},:\"';]+",
"name": "entity.name.type.parameter.bjolang"
},
"quoted-symbol": {
"match": "'[^\\s()\\[\\]{},:\"';]+",
"name": "constant.language.symbol.bjolang"
},
"quote": {
"patterns": [
{
"match": ",@",
"name": "keyword.operator.unquote.bjolang"
},
{
"match": ",",
"name": "keyword.operator.unquote.bjolang"
},
{
"match": "'",
"name": "keyword.operator.quote.bjolang"
}
]
},
"primitive-type": {
"match": "(?<![^\\s()\\[\\]{},:\"';])(?:decimal|ushort|double|string|short|ulong|sbyte|float|long|uint|byte|bool|char|void|unit|int)(?![^\\s()\\[\\]{},:\"';])",
"name": "support.type.primitive.bjolang"
},
"type-name": {
"comment": "A capitalised name: a type, a union case or a .NET class, Some and System.Text.StringBuilder alike.",
"match": "(?<![^\\s()\\[\\]{},:\"';])[A-Z][^\\s()\\[\\]{},:\"';]*",
"name": "entity.name.type.bjolang"
},
"braces": {
"comment": "A comprehension. A region, so that a } inside an interpolated string's hole closes the right one.",
"begin": "\\{",
"beginCaptures": {
"0": {
"name": "punctuation.section.braces.begin.bjolang"
}
},
"end": "\\}",
"endCaptures": {
"0": {
"name": "punctuation.section.braces.end.bjolang"
}
},
"patterns": [
{
"include": "#forms"
}
]
},
"delimiter": {
"patterns": [
{
"match": "\\(",
"name": "punctuation.section.parens.begin.bjolang"
},
{
"match": "\\)",
"name": "punctuation.section.parens.end.bjolang"
},
{
"match": "\\[",
"name": "punctuation.section.brackets.begin.bjolang"
},
{
"match": "\\]",
"name": "punctuation.section.brackets.end.bjolang"
}
]
}
}
}

16
manifest.bjodat Normal file
View file

@ -0,0 +1,16 @@
(package
(name (textmate-bjolang))
(version "0.1.0")
(description "Syntax highlighting for Bjolang: VS Code's TextMate grammars and themes, through TextMateSharp, as (text xml) nodes.")
(license "MPL-2.0")
;; TextMateSharp (MIT) runs the grammars; its Grammars package carries VS
;; Code's grammars and themes, and pulls in Onigwrap, the Oniguruma regex
;; engine as a native library. Kept within 2.0: the token colours are
;; decoded with a class in TextMateSharp's Internal namespace, which a
;; minor version may change.
(packages
(nuget (id "TextMateSharp.Grammars") (version "[2.0.4,2.1)")))
;; A library: there is no src/main.bjo.
)

29
packages.lock.json Normal file
View file

@ -0,0 +1,29 @@
{
"version": 1,
"dependencies": {
"net10.0": {
"TextMateSharp.Grammars": {
"type": "Direct",
"requested": "[2.0.4, 2.1.0)",
"resolved": "2.0.4",
"contentHash": "jzOY00q5u5Vs4L9n2m2PnRZDGwWt2uwkOLh7qlVdCx1kkGSn5eaW5XgnYCyTzEbsCwLV2xlEolnNkr/wuIMAbA==",
"dependencies": {
"TextMateSharp": "2.0.4"
}
},
"Onigwrap": {
"type": "Transitive",
"resolved": "1.0.11",
"contentHash": "5/WAxSYWfiiPzp1X13qqdqjFmYLKDD/U7Vh3WCkKxWG9BjqdrXnQE5fCKCFJX+xWvuYLTxwZIVWBwBWObViE8g=="
},
"TextMateSharp": {
"type": "Transitive",
"resolved": "2.0.4",
"contentHash": "5Pvn+A4zb1IF+ACAVhgw1aGf9kTyx6j7v5hdup7nCS89Nzby8KQAlCfQ54VC/GAsEoQwh4zKa5MKlAaql8nkPg==",
"dependencies": {
"Onigwrap": "1.0.11"
}
}
}
}
}

777
src/core.bjo Normal file
View file

@ -0,0 +1,777 @@
;; 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/src/core.bjo — the module (textmate-bjolang core).
;;
;; Syntax highlighting with VS Code's grammars and themes. TextMateSharp runs
;; them; what comes out is Bjolang values — lines of scoped tokens, lines of
;; styled spans — and (text xml) nodes for a page:
;;
;; (def hl (highlighter #:theme 'dark-plus))
;; (match (find-language hl "c#")
;; ((Some cs) (highlight->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 <x />, 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?)))))

181
tests/demo.bjo Normal file
View file

@ -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)