Joseph Ferano
2ba6a6cbf0
flan--special was three kinds of name in one list: the forms the parser dispatches on, the functions the compiler provides, and the words that stand for themselves. Drawing push like let said they were the same kind of thing. They are three lists now, each read off the file that decides it, and the two names in the old one that are not in the language at all -- cast and none -- are gone with it. What else had been missed: dyn, Allocator, Vec, Map, Fn, int and float were not types, $t was not anything, handler-case was not a keyword, a comma was not whitespace, & was not a name character -- which a macro's parameter list needs, now that it destructures -- imenu had no heading for a macro and none for the four dispatch forms, and a labelled loop indented its body under its own binding vector, which loops.flan has four of and would have said. Then the second half. The defs op already told the editor what every name is, and only completion and eldoc were listening, so a macro you defined looked exactly like a function you defined. It carried no macro kind to listen for and could not have: a macro is a defn by the time there is a program. So the op answers with one -- keeping the location off the defn it drops, so M-. still goes there -- and with the type names, read off the checker's environment, since an enum is an i32 and an alias is gone by then. The editor draws them by kind, after the static rules and never over them: a program defining its own length does not get to repaint the builtin. A hash table and a matcher rather than a regexp of every name, rebuilt when the cache is and not when a key is pressed. With no session the rules come off and the buffer is what it always was.
644 lines
27 KiB
EmacsLisp
644 lines
27 KiB
EmacsLisp
;;; test-flan-mode.el --- Indentation, from written-out shapes -*- lexical-binding: t; -*-
|
|
|
|
;; Loaded by test-flan-cider.el, which runs under `dune test'. It is not a
|
|
;; file of its own in test/dune deliberately: `emacs/*.el' is already a
|
|
;; dependency of that stanza, so a new `.el' here needs no build change.
|
|
;;
|
|
;; Every case is a piece of Flan written the way the corpus writes it, with
|
|
;; every line's indentation thrown away and put back. That is the whole test:
|
|
;; if what comes out is what went in, the indenter agrees with the code that
|
|
;; already exists. A case that is *not* in the corpus is written from
|
|
;; `clojure-mode''s behaviour and says so.
|
|
;;
|
|
;; The cases come from the bug report and from reading the tree for the shapes
|
|
;; that share it: a `let' binding vector, `defn' parameters with and without a
|
|
;; return type, `handler-bind' and `restart-case' clause parameters, and struct
|
|
;; literals in both the `:x' and the `.x' spelling — the two must agree,
|
|
;; because a lane is converting the corpus from one to the other and the
|
|
;; indenter is not allowed to notice.
|
|
|
|
;;; Code:
|
|
|
|
(require 'flan-mode)
|
|
|
|
;; The harness, which is test-flan-cider.el's: it counts and it reports, and
|
|
;; this file is loaded from there.
|
|
(declare-function test-flan--check "test-flan-cider" (name ok))
|
|
|
|
(defun test-flan-mode--reindent (text)
|
|
"Strip TEXT's indentation and let `flan-mode' put it back."
|
|
;; Quiet: `indent-region' reports progress, and in batch that lands in the
|
|
;; middle of the line a failure is being printed on.
|
|
(let ((inhibit-message t))
|
|
(with-temp-buffer
|
|
(insert text)
|
|
(flan-mode)
|
|
(goto-char (point-min))
|
|
;; Leading whitespace off every line but the first: the first line's column
|
|
;; is the buffer's, not the indenter's, and a form is indented relative to
|
|
;; where it starts. `eobp' rather than `forward-line''s return value,
|
|
;; which is 0 for a move to the end of a buffer that has no final newline
|
|
;; and would take the whole last line with it.
|
|
(forward-line 1)
|
|
(while (not (eobp))
|
|
(skip-chars-forward " \t")
|
|
(delete-region (line-beginning-position) (point))
|
|
(forward-line 1))
|
|
(indent-region (point-min) (point-max))
|
|
(buffer-substring-no-properties (point-min) (point-max)))))
|
|
|
|
(defun test-flan-mode--check (name text)
|
|
"Check that TEXT is what `flan-mode' indents it to."
|
|
(let ((got (test-flan-mode--reindent text)))
|
|
(test-flan--check name (equal got text))
|
|
(unless (equal got text)
|
|
;; Line by line, and quoted: the difference is always a count of leading
|
|
;; spaces, which is exactly what two blocks of text printed as-is make
|
|
;; hardest to see.
|
|
(let ((want (split-string text "\n")) (had (split-string got "\n")))
|
|
(while (or want had)
|
|
(unless (equal (car want) (car had))
|
|
(message " want %S\n got %S" (car want) (car had)))
|
|
(setq want (cdr want) had (cdr had)))))))
|
|
|
|
(message "\n-- indentation")
|
|
|
|
;; The bug, as reported: sand.flan's `settle'. The second and later bindings
|
|
;; went one column too far, because the enclosing open is `[' and the symbol
|
|
;; after it is the first binding's *name*, so the old check fell through to
|
|
;; `lisp-indent-function', which treated the vector as a call and aligned under
|
|
;; the first argument — `(+ gravity …)' — instead of under `vel'.
|
|
(test-flan-mode--check
|
|
"a let's bindings align name under name"
|
|
"(defn settle [row i32 col i32] ()
|
|
(let [vel (+ gravity (at velocity row col))
|
|
y (min (- rows 1) (+ row (i32 vel)))]
|
|
(while (> y row)
|
|
(set y (- y 1)))))")
|
|
|
|
;; The same shape one level in, which is where the report was actually hit: a
|
|
;; binding whose value is a struct literal, so the vector's alignment has to
|
|
;; survive a `{' in the middle of it.
|
|
(test-flan-mode--check
|
|
"and still does with a struct literal in a value"
|
|
"(let [tip (rl/Vector2 {.x 15.0 .y 12.0})
|
|
vel (+ gravity 1.0)]
|
|
(draw tip vel))")
|
|
|
|
;; The two spellings must be indented identically. Nothing in the indenter
|
|
;; looks at the key — a brace aligns under its first element whatever that
|
|
;; element is — and this is the test that keeps it that way while the corpus
|
|
;; moves from `:x' to `.x'.
|
|
(test-flan-mode--check
|
|
"a struct literal aligns under its first field"
|
|
"(rl/Rectangle {.x 0.0 .y 0.0
|
|
.width (f32 screen-width)
|
|
.height (f32 screen-height)})")
|
|
|
|
;; The colon spelling is gone from the language — the parser refuses it — but a
|
|
;; map literal will be written this way, and the indenter must not have learned
|
|
;; the difference: it aligns under the first element of a brace and never looks
|
|
;; at what that element is spelled like.
|
|
(test-flan-mode--check
|
|
"and a brace of keyword keys aligns exactly the same way"
|
|
"(counts {:north 0 :south 1
|
|
:east 2
|
|
:west 3})")
|
|
|
|
;; `defn' carries a return type between the parameters and the body, and it is
|
|
;; optional. Both spellings indent the body by two, which is why the spec is
|
|
;; `:defn' and not a count: a count would have to know whether the type is
|
|
;; there.
|
|
(test-flan-mode--check
|
|
"a defn with a return type indents its body by two"
|
|
"(defn look [n i64 label string] i64
|
|
(print label)
|
|
n)")
|
|
|
|
(test-flan-mode--check
|
|
"and a defn without one indents it the same"
|
|
"(defn show-trim [s string] ()
|
|
(print s)
|
|
(println \"\"))")
|
|
|
|
;; A parameter list that wraps is the binding-vector rule again: it is a
|
|
;; vector, so it aligns under its first element and not under its second.
|
|
(test-flan-mode--check
|
|
"a wrapped parameter list aligns under the first parameter"
|
|
"(defn move-grain [row i32 col i32
|
|
to-row i32 to-col i32
|
|
vel f32] ()
|
|
(set moved true))")
|
|
|
|
;; `handler-bind' clauses: the vector is the special argument, and each clause
|
|
;; inside it is `(Name [params] body…)' — `defn' with the name left off. The
|
|
;; body indents by two from the clause's own paren, which is the rule the head
|
|
;; cannot be looked up for: `StorageExhausted' is a name the program invented.
|
|
(test-flan-mode--check
|
|
"a handler-bind clause indents its body under its own paren"
|
|
"(handler-bind
|
|
[(StorageExhausted [c]
|
|
(set failures (+ failures 1))
|
|
(invoke-restart 'retry))]
|
|
(load-all))")
|
|
|
|
(test-flan-mode--check
|
|
"and two clauses in one vector line up with each other"
|
|
"(handler-bind [(AssetMissing [c] (set seen (+ seen 10)))
|
|
(Corrupt [c] (set other (+ other 1)))]
|
|
(load-all))")
|
|
|
|
;; `restart-case' is 1 rather than 0: with 0 a protected form written on the
|
|
;; head's line would drag every clause out to align under it.
|
|
(test-flan-mode--check
|
|
"restart-case clauses indent by two under a protected form on the head's line"
|
|
"(defn fetch [n i32] i32
|
|
(restart-case (middle n)
|
|
(use-placeholder [] -1)
|
|
(retry [] 7)))")
|
|
|
|
(test-flan-mode--check
|
|
"and by two when the protected form is on its own line"
|
|
"(restart-case
|
|
(do (agent/poll)
|
|
(game-update))
|
|
(continue [] (do)))")
|
|
|
|
;; `declare-c' writes its parameters, return type and C symbol down the page in
|
|
;; one column.
|
|
(test-flan-mode--check
|
|
"declare-c puts everything after the name in one column"
|
|
"(declare-c mouse-button-pressed?
|
|
[button MouseButton] bool
|
|
\"IsMouseButtonPressed\")")
|
|
|
|
;; An ordinary call, in the two cases every Lisp separates.
|
|
(test-flan-mode--check
|
|
"a call with an argument on the head's line aligns under that argument"
|
|
"(rl/draw-text \"hello\"
|
|
10 20 30)")
|
|
|
|
(test-flan-mode--check
|
|
"a call whose head is alone on its line indents its arguments by a body"
|
|
"(rl/draw-rectangle-lines-ex
|
|
(rl/Rectangle {.x 0.0 .y 0.0})
|
|
(f32 2.0) (rl/get-color 0x303030FF))")
|
|
|
|
;; A `do' is all body, so its second form aligns under its first.
|
|
(test-flan-mode--check
|
|
"a do aligns its forms with the first one"
|
|
"(do (agent/poll)
|
|
(game-update))")
|
|
|
|
;; Field access is an ordinary call whose head begins with a dot. `.' is a
|
|
;; symbol constituent, so nothing special is needed — but if it ever stopped
|
|
;; being one, `(.x v)' would start indenting as data and this is what would
|
|
;; say so.
|
|
(test-flan-mode--check
|
|
"field access indents as the call it is"
|
|
"(set total
|
|
(+ (.bytes c)
|
|
(.align c)))")
|
|
|
|
;; `#_' discards the form after it, so the reader sees pairs either way and the
|
|
;; alignment must not shift. See `lib/reader.ml'.
|
|
(test-flan-mode--check
|
|
"a discarded binding does not disturb the pairs around it"
|
|
"(let [#_a #_1 b 2
|
|
c 3]
|
|
(print c))")
|
|
|
|
;; A labelled loop, from `test/programs/loops.flan'. The label is a keyword
|
|
;; written where the binding vector would otherwise go, so it pushes everything
|
|
;; along by one — and until the indenter was told, the body of a labelled loop
|
|
;; was dragged out under its own binding vector.
|
|
(test-flan-mode--check
|
|
"a labelled dotimes indents its body by two, not under its vector"
|
|
"(dotimes :outer [a 3]
|
|
(dotimes [b 3]
|
|
(when (= b 2) (break :outer))
|
|
(print b) (println \"\")))")
|
|
|
|
;; `until' takes one on the same rule, and there the special argument is a test
|
|
;; rather than a vector — which is the case that shows the rule is about the
|
|
;; label and not about brackets.
|
|
(test-flan-mode--check
|
|
"and so does a labelled until, whose special argument is a test"
|
|
"(until :count (> n 10)
|
|
(set n (+ n 1))
|
|
(when (= n 3) (break :count)))")
|
|
|
|
;; The unlabelled form must not have moved, which is the other half of the
|
|
;; same claim.
|
|
(test-flan-mode--check
|
|
"an unlabelled dotimes is where it always was"
|
|
"(dotimes [b 3]
|
|
(print b)
|
|
(println \"\"))")
|
|
|
|
;; `dotimes' binding vectors now hold up to four elements — name, start, stop,
|
|
;; step — and the indenter must not have learned a count. The vector is one
|
|
;; sexp whatever is in it, so the body is two in from the head in every arity,
|
|
;; and a vector that wraps aligns under its own first element. From
|
|
;; `test/programs/dotimes-range.flan'.
|
|
(test-flan-mode--check
|
|
"a three-element dotimes vector indents its body by two"
|
|
"(dotimes [i 2 5]
|
|
(print i)
|
|
(println \"\"))")
|
|
|
|
(test-flan-mode--check
|
|
"and a four-element one, counting down, does the same"
|
|
"(dotimes [i 9 -1 -1]
|
|
(print i)
|
|
(println \"\"))")
|
|
|
|
(test-flan-mode--check
|
|
"and a binding vector that wraps aligns under its first element"
|
|
"(dotimes [i 0
|
|
(length items)
|
|
2]
|
|
(print i))")
|
|
|
|
;; The object and dispatch forms all begin `def', so they reach the `:defn'
|
|
;; fallback and indent their bodies by two. `defmethod' is the one with two
|
|
;; names before the parameter vector — the generic and the dispatch value —
|
|
;; which is exactly the case a count would have got wrong. From
|
|
;; `test/programs/dev-classes.flan'.
|
|
(test-flan-mode--check
|
|
"a defmethod indents its body by two, past generic and dispatch value"
|
|
"(defmethod area point [p]
|
|
(* (get p :x)
|
|
(get p :y)))")
|
|
|
|
(test-flan-mode--check
|
|
"a defclass puts its slot vector in the body column"
|
|
"(defclass point
|
|
[x y])")
|
|
|
|
(test-flan-mode--check
|
|
"and a defmulti indents its body by two"
|
|
"(defmulti describe [thing] dyn
|
|
(class-of thing))")
|
|
|
|
;; `fn' is `defn' with no name and no return type: the parameter vector, then
|
|
;; the body. From `test/programs/higher-order.flan', written down the page.
|
|
(test-flan-mode--check
|
|
"an fn indents its body under its parameters by two"
|
|
"(sort-by s (fn [a b]
|
|
(< a b)))")
|
|
|
|
;; A macro body indents by two like any `def…' form. It reaches that through
|
|
;; the `\\`def' fallback rather than through an entry, which is worth pinning:
|
|
;; the fallback is what covers every definer nobody listed.
|
|
(test-flan-mode--check
|
|
"a defmacro indents its body by two"
|
|
"(defmacro both [& args]
|
|
`(do ~@args))")
|
|
|
|
;; A macro's parameter list destructures now, so it holds names and a `&'
|
|
;; rest marker rather than one blob. It is still a vector, so a list that
|
|
;; wraps aligns name under name like every other vector here — and `&' is a
|
|
;; name character, so it does not split the marker off from what follows.
|
|
(test-flan-mode--check
|
|
"a wrapped destructuring parameter list aligns under its first parameter"
|
|
"(defmacro guard [test message
|
|
& body]
|
|
`(when ~test ~@body))")
|
|
|
|
;; A generic `defn' writes its constraint map between the return type and the
|
|
;; body — `test/programs/generic-map-reject.flan'. It is a brace, so it aligns
|
|
;; under its first element like every other brace, and the body after it is
|
|
;; still two in from `defn'.
|
|
(test-flan-mode--check
|
|
"a where clause sits in the body column and does not move the body"
|
|
"(defn seen? [k $t] bool
|
|
{:where (hashable? $t)}
|
|
(let [m (map-new t i32)]
|
|
(put m k 1)))")
|
|
|
|
;; A comma is whitespace, so a vector written with commas is the same vector
|
|
;; and lines up the same way. It reads as one now because the syntax table
|
|
;; says so; before, a comma was punctuation and sat in the middle of a name.
|
|
(test-flan-mode--check
|
|
"commas between bindings change nothing"
|
|
"(let [vel 1.0,
|
|
y 2.0]
|
|
(print y))")
|
|
|
|
|
|
;;; Font lock
|
|
|
|
;; The colon-to-dot change left every field label in the corpus unfontified:
|
|
;; the keyword rule used to cover them, and the colon belongs to keywords now.
|
|
|
|
(defun test-flan-mode--face-at (text needle)
|
|
"The face on the first character of NEEDLE in TEXT, under `flan-mode'."
|
|
(with-temp-buffer
|
|
(insert text)
|
|
(flan-mode)
|
|
(font-lock-ensure)
|
|
(goto-char (point-min))
|
|
(search-forward needle)
|
|
(get-text-property (- (point) (length needle)) 'face)))
|
|
|
|
(message "\n-- font lock")
|
|
|
|
(dolist (case '(("(rl/Vector2 {.x 1.0 .y 2.0})" ".x" "a struct literal's field label")
|
|
("(rl/Vector2 {.x 1.0 .y 2.0})" ".y" "and the second one")
|
|
("(set total (.bytes c))" ".bytes" "a field accessor")
|
|
;; The keyword rule is still there: an enum member is one.
|
|
("(rl/mouse-button-down? :mouse-left)" ":mouse-left" "an enum member")))
|
|
(test-flan--check (format "%s is a constant" (nth 2 case))
|
|
(eq (test-flan-mode--face-at (nth 0 case) (nth 1 case))
|
|
'font-lock-constant-face)))
|
|
|
|
;; A dot inside a number is not a label, and neither is the dot in a name that
|
|
;; has one in the middle.
|
|
;; A dot in the middle of a name is not a label: `\_<' anchors the rule to the
|
|
;; start of a symbol, and `a.b' is one symbol starting at `a'.
|
|
(test-flan--check "a dot inside a name does not start a label"
|
|
(null (test-flan-mode--face-at "(f alpha.beta)" ".beta")))
|
|
|
|
;; The pass over the static table. Each row is a piece of the corpus and the
|
|
;; face the name in it should carry; several of these were drawn as nothing at
|
|
;; all until the table was brought back into line with `lib/parse.ml' and
|
|
;; `lib/check.ml'.
|
|
(dolist (case '(;; A definer that was missing: the head was not a keyword and
|
|
;; the name after it was not a function name.
|
|
("(defmacro both [& args] `(do ~@args))" "defmacro"
|
|
font-lock-keyword-face "defmacro's head")
|
|
("(defmacro both [& args] `(do ~@args))" "both"
|
|
font-lock-function-name-face "and the macro's name")
|
|
("(declare-c mouse-down? [b i32] bool \"X\")" "declare-c"
|
|
font-lock-keyword-face "declare-c's head")
|
|
;; The defining forms that arrived with the object system and
|
|
;; with the def/defonce/defconst trio.
|
|
("(def ticks i64 0)" "def" font-lock-keyword-face "def's head")
|
|
("(def ticks i64 0)" "ticks" font-lock-function-name-face
|
|
"and the name it introduces")
|
|
("(defonce seed i64 1)" "defonce" font-lock-keyword-face
|
|
"defonce")
|
|
("(defclass point [x y])" "defclass" font-lock-keyword-face
|
|
"defclass")
|
|
("(defgeneric area [self] dyn)" "defgeneric"
|
|
font-lock-keyword-face "defgeneric")
|
|
("(defmethod area point [p] 1)" "defmethod"
|
|
font-lock-keyword-face "defmethod")
|
|
;; `handler-case' is implemented now and is a keyword like the
|
|
;; other three condition forms.
|
|
("(handler-case (go) [(E [c] 1)])" "handler-case"
|
|
font-lock-keyword-face "handler-case")
|
|
;; Special forms the old list had never heard of.
|
|
("(cond (= a 1) 2)" "cond" font-lock-keyword-face "cond")
|
|
("(and a b)" "and" font-lock-keyword-face "and")
|
|
("(handler-bind [(E [c] 1)] (go))" "handler-bind"
|
|
font-lock-keyword-face "handler-bind")
|
|
("(restart-case (go) (retry [] 1))" "restart-case"
|
|
font-lock-keyword-face "restart-case")
|
|
("(signal ArithError {.op 1})" "signal"
|
|
font-lock-keyword-face "signal")
|
|
("(dotimes [b 3] (break :outer))" "break"
|
|
font-lock-keyword-face "break")
|
|
;; A builtin is a call, not a form the parser knows, and it is
|
|
;; drawn as one.
|
|
("(push v 1)" "push" font-lock-builtin-face "a builtin")
|
|
("(slice xs 0 4)" "slice" font-lock-builtin-face "and another")
|
|
("(bytes-view b)" "bytes-view" font-lock-builtin-face
|
|
"bytes-view")
|
|
("(length xs)" "length" font-lock-builtin-face "length")
|
|
("(class-of x)" "class-of" font-lock-builtin-face "class-of")
|
|
("(filled xs 0)" "filled" font-lock-builtin-face "filled")
|
|
;; Types.
|
|
("(defn f [x dyn] dyn x)" "dyn" font-lock-type-face "dyn")
|
|
("(def v (Vec u8))" "Vec" font-lock-type-face "Vec")
|
|
("(declare apply [(Fn [i64] i64)] i64)" "Fn"
|
|
font-lock-type-face "Fn")
|
|
("(defn seen? [k $t] bool 1)" "$t" font-lock-type-face
|
|
"a type variable")
|
|
;; The package alias of a qualified name, `clojure-mode''s
|
|
;; rule for a namespace.
|
|
("(rl/draw-text \"hi\" 1 2 3)" "rl" font-lock-type-face
|
|
"a package alias")
|
|
("(defn f [x int] float 1.0)" "int" font-lock-type-face
|
|
"int, the builtin alias")
|
|
;; Constants that stand for themselves.
|
|
("(set done true)" "true" font-lock-constant-face "true")
|
|
("(= o None)" "None" font-lock-constant-face "None")
|
|
("(set x nil)" "nil" font-lock-constant-face "nil")
|
|
("(def buf (Vec u8) uninit)" "uninit" font-lock-constant-face
|
|
"uninit, which is only ever written here")))
|
|
(test-flan--check (format "%s is drawn" (nth 3 case))
|
|
(eq (test-flan-mode--face-at (nth 0 case) (nth 1 case))
|
|
(nth 2 case))))
|
|
|
|
;; `context/allocator' has a slash in it and is not a qualified name: there is
|
|
;; no package called `context'. The constants rule runs first for exactly this
|
|
;; reason, and this is what would notice if it stopped.
|
|
(test-flan--check
|
|
"context/allocator is one constant and not an alias and a name"
|
|
(eq (test-flan-mode--face-at "(free-all (context/allocator))" "context/")
|
|
'font-lock-constant-face))
|
|
|
|
;; The name after a package alias is left for the running program to speak for
|
|
;; — see the dynamic section below. With no program it is undrawn, and that is
|
|
;; the state a file opened on its own is in.
|
|
(test-flan--check
|
|
"the name after the alias is left alone"
|
|
(null (test-flan-mode--face-at "(rl/draw-text \"hi\" 1 2 3)" "draw-text")))
|
|
|
|
|
|
;;; Font lock from the running program
|
|
|
|
;; `flan.el' adds a second set of rules that draw what the program *defines* —
|
|
;; a macro as a macro, a function as a function — and everything below drives
|
|
;; them from a fixture `flan--defs' rather than from a daemon. The live half,
|
|
;; where an evaluation is accepted and the name lights up without anyone asking
|
|
;; for it, is in test-flan.el, which has a program to evaluate against.
|
|
|
|
(require 'flan)
|
|
|
|
(defconst test-flan-mode--defs
|
|
;; The shape `Dev.defs' answers with: (NAME KIND SIGNATURE LOC DOC).
|
|
'(("settle" "fn" "settle [i32 i32] ()" "sand.flan:3" "")
|
|
("ticks" "var" "ticks i64" "" "")
|
|
("gravity" "const" "gravity f32" "" "")
|
|
("with-retry" "macro" "with-retry [args] Form" "" "")
|
|
("Pixel" "struct" "Pixel" "" "")
|
|
("Shape" "data" "Shape" "" "")
|
|
("Key" "enum" "Key" "" "")
|
|
("sim/step" "fn" "sim/step [] ()" "sand.flan:9" "")
|
|
("a/draw" "fn" "a/draw [] ()" "" "")
|
|
("b/draw" "fn" "b/draw [] ()" "" "")
|
|
;; The program is allowed to define a name the language already uses. It
|
|
;; does not get to repaint it.
|
|
("length" "fn" "length [i32] i32" "" "")
|
|
("if" "fn" "if [i32] i32" "" "")
|
|
;; And a kind this editor has never heard of, which the daemon is allowed
|
|
;; to add.
|
|
("somenewthing" "sigil" "somenewthing" "" ""))
|
|
"A `defs' reply to draw against.")
|
|
|
|
(defun test-flan-mode--dyn-face (text needle &optional defs)
|
|
"The face on NEEDLE in TEXT with DEFS as what the program defines."
|
|
(let ((flan--defs (if (eq defs 'none) nil (or defs test-flan-mode--defs))))
|
|
(flan--dynamic-rebuild)
|
|
(with-temp-buffer
|
|
(insert text)
|
|
(flan-mode)
|
|
(flan--dynamic-install)
|
|
(font-lock-ensure)
|
|
(goto-char (point-min))
|
|
(search-forward needle)
|
|
(get-text-property (- (point) (length needle)) 'face))))
|
|
|
|
(message "\n-- font lock from the program")
|
|
|
|
(dolist (case '(("(settle 1 2)" "settle" flan-function-face "a function")
|
|
("(set ticks 0)" "ticks" flan-global-face "a global")
|
|
("(print gravity)" "gravity" flan-global-face "a constant")
|
|
("(with-retry (go))" "with-retry" flan-macro-face "a macro")
|
|
("(def p (Vec Pixel))" "Pixel" flan-type-face "a struct")
|
|
("(defn f [s Shape] () 1)" "Shape" flan-type-face "a data type")
|
|
("(def k Key)" "Key" flan-type-face "an enum")))
|
|
(test-flan--check (format "%s the program defines is drawn as one" (nth 3 case))
|
|
(eq (test-flan-mode--dyn-face (nth 0 case) (nth 1 case))
|
|
(nth 2 case))))
|
|
|
|
;; A macro and a function must not look alike — the whole point — so this is
|
|
;; asserted as a difference and not only as two faces.
|
|
(test-flan--check
|
|
"a macro and a function are not drawn the same"
|
|
(not (eq (test-flan-mode--dyn-face "(with-retry (go))" "with-retry")
|
|
(test-flan-mode--dyn-face "(settle 1 2)" "settle"))))
|
|
|
|
;; A constructor is `Type.Case' and is one symbol, so the type half is what
|
|
;; the program can speak for and the case half is left alone.
|
|
(test-flan--check
|
|
"a constructor's type half is drawn"
|
|
(eq (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" "Shape")
|
|
'flan-type-face))
|
|
|
|
(test-flan--check
|
|
"and its case half is not"
|
|
(null (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" ".Dot")))
|
|
|
|
(test-flan--check
|
|
"a name the program has never heard of is left alone"
|
|
(null (test-flan-mode--dyn-face "(never-defined 1)" "never-defined")))
|
|
|
|
(test-flan--check
|
|
"and so is a kind this editor does not know"
|
|
(null (test-flan-mode--dyn-face "(somenewthing)" "somenewthing")))
|
|
|
|
;; The static rules win, and they win in both directions: a program function
|
|
;; called `length' keeps the builtin colour, and one called `if' keeps the
|
|
;; keyword colour.
|
|
(test-flan--check
|
|
"a program function named length is still drawn as the builtin"
|
|
(eq (test-flan-mode--dyn-face "(length xs)" "length")
|
|
'font-lock-builtin-face))
|
|
|
|
(test-flan--check
|
|
"and one named if is still drawn as the special form"
|
|
(eq (test-flan-mode--dyn-face "(if a 1 2)" "if") 'font-lock-keyword-face))
|
|
|
|
;; A buffer inside a package writes `step' for what the program calls
|
|
;; `sim/step'. One package offers it, so it resolves — the rule `flan--lookup'
|
|
;; already follows for eldoc and `M-.'.
|
|
(test-flan--check
|
|
"an unqualified name that one package offers is drawn"
|
|
(eq (test-flan-mode--dyn-face "(step)" "step") 'flan-function-face))
|
|
|
|
(test-flan--check
|
|
"and one that two packages offer is not, because that would be a guess"
|
|
(null (test-flan-mode--dyn-face "(draw)" "draw")))
|
|
|
|
;; With no session there is nothing to say, and the buffer has to be drawn
|
|
;; exactly as `flan-mode' alone draws it.
|
|
(test-flan--check
|
|
"with no session a program name is undrawn"
|
|
(null (test-flan-mode--dyn-face "(settle 1 2)" "settle" 'none)))
|
|
|
|
(test-flan--check
|
|
"and the language is drawn as it always was"
|
|
(eq (test-flan-mode--dyn-face "(let [a 1] a)" "let" 'none)
|
|
'font-lock-keyword-face))
|
|
|
|
;; Whole-buffer, because "nothing changes" is a claim about every character and
|
|
;; not about one name: a corpus file drawn with no session must come out
|
|
;; character for character and face for face as it did before any of this.
|
|
(defun test-flan-mode--faces (text &optional defs)
|
|
"Every (POS . FACE) in TEXT, with DEFS as what the program defines."
|
|
(let ((flan--defs (if (eq defs 'none) nil defs)))
|
|
(flan--dynamic-rebuild)
|
|
(with-temp-buffer
|
|
(insert text)
|
|
(flan-mode)
|
|
(flan--dynamic-install)
|
|
(font-lock-ensure)
|
|
(let (acc)
|
|
(dotimes (i (1- (point-max)))
|
|
(push (get-text-property (1+ i) 'face) acc))
|
|
(nreverse acc)))))
|
|
|
|
(let ((text "(defn settle [row i32] ()\n (let [vel gravity]\n (set ticks vel)))\n"))
|
|
(test-flan--check
|
|
"a buffer with no session is drawn exactly as the mode alone draws it"
|
|
(equal (test-flan-mode--faces text 'none)
|
|
(let ((flan-font-lock-dynamically nil))
|
|
(test-flan-mode--faces text test-flan-mode--defs))))
|
|
;; ...and turning the setting off with a session up is the same picture,
|
|
;; which is what makes it an off switch rather than a reconnect.
|
|
(test-flan--check
|
|
"and turning the option off gives that same picture back"
|
|
(equal (test-flan-mode--faces text 'none)
|
|
(let ((flan-font-lock-dynamically nil))
|
|
(test-flan-mode--faces text test-flan-mode--defs))))
|
|
(test-flan--check
|
|
"while with one it is drawn differently"
|
|
(not (equal (test-flan-mode--faces text 'none)
|
|
(test-flan-mode--faces text test-flan-mode--defs)))))
|
|
|
|
;; Installing twice must not leave two copies of the rule behind: a refresh
|
|
;; happens after every accepted evaluation, and a rule added each time would
|
|
;; make redisplay slower for as long as the session lasted.
|
|
(test-flan--check
|
|
"installing repeatedly leaves one copy of the rule"
|
|
(let ((flan--defs test-flan-mode--defs))
|
|
(flan--dynamic-rebuild)
|
|
(with-temp-buffer
|
|
(flan-mode)
|
|
(font-lock-ensure)
|
|
(dotimes (_ 5) (flan--dynamic-install))
|
|
(= 1 (seq-count (lambda (k) (equal k (car flan--dynamic-keywords)))
|
|
font-lock-keywords)))))
|
|
|
|
;;; Electric pairs
|
|
|
|
;; `electric-pair-mode' reads the syntax table and nothing else, so the three
|
|
;; bracket pairs Flan writes work without a word being said about them — and
|
|
;; that is exactly why it wants a test: the table gained entries in this pass,
|
|
;; and a mistake in one of them would show up here first.
|
|
|
|
(message "\n-- electric pairs")
|
|
|
|
(defun test-flan-mode--pair (open)
|
|
"Type OPEN in a Flan buffer with `electric-pair-mode' on, and read the line."
|
|
(with-temp-buffer
|
|
(flan-mode)
|
|
(electric-pair-local-mode 1)
|
|
(let ((last-command-event open))
|
|
(call-interactively #'self-insert-command))
|
|
(buffer-string)))
|
|
|
|
(dolist (case '((?\( "()" "a paren")
|
|
(?\[ "[]" "a bracket")
|
|
(?{ "{}" "a brace")
|
|
(?\" "\"\"" "a string")))
|
|
(test-flan--check (format "%s closes itself" (nth 2 case))
|
|
(equal (test-flan-mode--pair (nth 0 case)) (nth 1 case))))
|
|
|
|
(provide 'test-flan-mode)
|
|
;;; test-flan-mode.el ends here
|