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>
181 lines
10 KiB
Text
181 lines
10 KiB
Text
;; 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)
|